
11 Aug '25
Ben Gamari pushed to branch wip/T26268 at Glasgow Haskell Compiler / GHC
Commits:
4d5bc565 by Ben Gamari at 2025-08-11T13:33:48-04:00
Bump time submodule to 1.15
Also required bumps of Cabal, directory, and hpc.
- - - - -
6 changed files:
- compiler/ghc.cabal.in
- ghc/ghc-bin.cabal.in
- libraries/Cabal
- libraries/directory
- libraries/hpc
- libraries/time
Changes:
=====================================
compiler/ghc.cabal.in
=====================================
@@ -120,7 +120,7 @@ Library
process >= 1 && < 1.7,
bytestring >= 0.11 && < 0.13,
binary == 0.8.*,
- time >= 1.4 && < 1.15,
+ time >= 1.4 && < 1.16,
containers >= 0.6.2.1 && < 0.9,
array >= 0.1 && < 0.6,
filepath >= 1.5 && < 1.6,
=====================================
ghc/ghc-bin.cabal.in
=====================================
@@ -64,7 +64,7 @@ Executable ghc
ghci == @ProjectVersionMunged@,
haskeline == 0.8.*,
exceptions == 0.10.*,
- time >= 1.8 && < 1.15
+ time >= 1.8 && < 1.16
CPP-Options: -DHAVE_INTERNAL_INTERPRETER
Other-Modules:
GHCi.Leak
=====================================
libraries/Cabal
=====================================
@@ -1 +1 @@
-Subproject commit 703582f80f6d7f0c914ef4b885affcfc7b7b6ec8
+Subproject commit d9b0904b49dc84e0bfc79062daf2bbdf9d22a422
=====================================
libraries/directory
=====================================
@@ -1 +1 @@
-Subproject commit ffd4fc248ee36095ddec55598b0f8e3a9ac762a8
+Subproject commit 6442a3cf04f74d82cdf8c9213324313d52b23d28
=====================================
libraries/hpc
=====================================
@@ -1 +1 @@
-Subproject commit 7b7aed397cbe2bb36824d8627527fa4d5abffaa6
+Subproject commit 12675279dc5cbea4ade8b5157b080390d598f03f
=====================================
libraries/time
=====================================
@@ -1 +1 @@
-Subproject commit e5c5d1987011efe88a21ab6ded45aaa33a16274f
+Subproject commit 507f50844802f1469ba6cadfeefd4e3fecee0416
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d5bc565d4e361047a8153005a80275…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d5bc565d4e361047a8153005a80275…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/spj-apporv-Oct24] 6 commits: Handle non-fractional CmmFloats in Cmm's CBE (#26229)
by Apoorv Ingle (@ani) 11 Aug '25
by Apoorv Ingle (@ani) 11 Aug '25
11 Aug '25
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
03555ed8 by Sylvain Henry at 2025-08-10T22:20:57-04:00
Handle non-fractional CmmFloats in Cmm's CBE (#26229)
Since f8d9d016305be355f518c141f6c6d4826f2de9a2, toRational for Float and
Double converts float's infinity and NaN into Rational's infinity and
NaN (respectively 1%0 and 0%0).
Cmm CommonBlockEliminator hashing function needs to take these values
into account as they can appear as literals now. See added testcase.
- - - - -
6c956af3 by J. Ryan Stinnett at 2025-08-10T22:21:42-04:00
Fix extensions list in `DoAndIfThenElse` docs
- - - - -
6dc420b1 by J. Ryan Stinnett at 2025-08-10T22:21:42-04:00
Document status of `RelaxedPolyRec` extension
This adds a brief extension page explaining the status of the
`RelaxedPolyRec` extension. The behaviour of this mode is already
explained elsewhere, so this page is mainly for completeness so that
various lists of extensions have somewhere to point to for this flag.
Fixes #18630
- - - - -
18036d52 by Simon Peyton Jones at 2025-08-11T11:31:20-04:00
Take more care in zonkEqTypes on AppTy/AppTy
This patch fixes #26256.
See Note [zonkEqTypes and the PKTI] in GHC.Tc.Solver.Equality
- - - - -
c8d76a29 by Zubin Duggal at 2025-08-11T11:32:02-04:00
ci: upgrade bootstrap compiler on windows to 9.10.1
- - - - -
6d1a2dac by Apoorv Ingle at 2025-08-11T12:08:40-05:00
This commit:
- Streamlines implementations of `tcExpr` and `tcXExpr` to work on `XExpr`
Calls `setInGeneratedCode` everytime the typechecker goes over an `XExpr`
- Kills `VACtxt` (and its associated VAExpansion and VACall) datatype, it is subsumed by simply a SrcSpan.
- Kills the function `addHeadCtxt` as it is now mearly setting a location
- The function `tcValArgs` does its own argument number management
- Makes `splitHsApps` not look through `XExpr`
- `tcExprSigma` is called if the head of the expression after calling `splitHsApps` turns out to be an `XExpr`
- Removes location information from `OrigPat` payload
- Removes special case of tcBody from `tcLambdaMatches`
- Removes special case of `dsExpr` for `ExpandedThingTc`
- Moves `setQLInstLevel` inside `tcInstFun`
- Rename `HsThingRn` to `SrcCodeCtxt`
- Kills `tcl_in_gen_code` and `tcl_err_ctxt`. It is subsumed by `ErrCtxtStack`
- Kills `ExpectedFunTyOrig`. It is subsumed by `CtOrigin`
- Fixes `CtOrigin` for `HsProjection` case in `exprCtOrigin`. It was previously assigned to be `SectionOrigin`. It is now just the expression
- Adds a new `CtOrigin.ExpansionOrigin` for storing the original syntax
- Adds a new `CtOrigin.ExpectedTySyntax` as a replacement for `ExpectedTySyntaxOp`. Cannot kill the former yet because of `ApplicativeDo`
- Renames `tcMonoExpr` -> `tcMonoLExpr`, `tcMonoExprNC` -> `tcMonoLExpr`
- Renames `EValArg`, `EValArgQL` fields: `ea_ctxt` -> `ea_loc_span` and `eaql_ctx` -> `eaql_loc_span`
Notes added [Error Context Stack]
Notes updated Note [Expanding HsDo with XXExprGhcRn]
-------------------------
Metric Decrease:
T9020
-------------------------
- - - - -
69 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- + compiler/GHC/Tc/Gen/App.hs-boot
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/Unify.hs
- docs/users_guide/conf.py
- docs/users_guide/expected-undocumented-flags.txt
- docs/users_guide/exts/doandifthenelse.rst
- + docs/users_guide/exts/relaxed_poly_rec.rst
- docs/users_guide/exts/types.rst
- testsuite/tests/default/default-fail05.stderr
- testsuite/tests/indexed-types/should_fail/T2693.stderr
- testsuite/tests/indexed-types/should_fail/T5439.stderr
- + testsuite/tests/numeric/should_compile/T26229.hs
- testsuite/tests/numeric/should_compile/all.T
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
- + testsuite/tests/partial-sigs/should_compile/T26256.hs
- + testsuite/tests/partial-sigs/should_compile/T26256.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- testsuite/tests/plugins/test-defaulting-plugin.stderr
- testsuite/tests/polykinds/T13393.stderr
- testsuite/tests/printer/T17697.stderr
- testsuite/tests/rep-poly/RepPolyDoBind.stderr
- testsuite/tests/rep-poly/RepPolyDoBody1.stderr
- testsuite/tests/rep-poly/RepPolyDoBody2.stderr
- testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr
- testsuite/tests/typecheck/should_compile/T14590.stderr
- + testsuite/tests/typecheck/should_compile/T26256a.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion1.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
- testsuite/tests/typecheck/should_fail/T10971d.stderr
- testsuite/tests/typecheck/should_fail/T13311.stderr
- testsuite/tests/typecheck/should_fail/T24064.stderr
- testsuite/tests/typecheck/should_fail/T3323.stderr
- testsuite/tests/typecheck/should_fail/T3613.stderr
- testsuite/tests/typecheck/should_fail/T7851.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- testsuite/tests/typecheck/should_fail/T9612.stderr
- testsuite/tests/typecheck/should_fail/tcfail102.stderr
- testsuite/tests/typecheck/should_fail/tcfail128.stderr
- testsuite/tests/typecheck/should_fail/tcfail168.stderr
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90a013ab3a8b40d04513214b4bbf90…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90a013ab3a8b40d04513214b4bbf90…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Ben Gamari pushed new branch wip/T26268 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T26268
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/fix-26109] 6 commits: Handle non-fractional CmmFloats in Cmm's CBE (#26229)
by recursion-ninja (@recursion-ninja) 11 Aug '25
by recursion-ninja (@recursion-ninja) 11 Aug '25
11 Aug '25
recursion-ninja pushed to branch wip/fix-26109 at Glasgow Haskell Compiler / GHC
Commits:
03555ed8 by Sylvain Henry at 2025-08-10T22:20:57-04:00
Handle non-fractional CmmFloats in Cmm's CBE (#26229)
Since f8d9d016305be355f518c141f6c6d4826f2de9a2, toRational for Float and
Double converts float's infinity and NaN into Rational's infinity and
NaN (respectively 1%0 and 0%0).
Cmm CommonBlockEliminator hashing function needs to take these values
into account as they can appear as literals now. See added testcase.
- - - - -
6c956af3 by J. Ryan Stinnett at 2025-08-10T22:21:42-04:00
Fix extensions list in `DoAndIfThenElse` docs
- - - - -
6dc420b1 by J. Ryan Stinnett at 2025-08-10T22:21:42-04:00
Document status of `RelaxedPolyRec` extension
This adds a brief extension page explaining the status of the
`RelaxedPolyRec` extension. The behaviour of this mode is already
explained elsewhere, so this page is mainly for completeness so that
various lists of extensions have somewhere to point to for this flag.
Fixes #18630
- - - - -
18036d52 by Simon Peyton Jones at 2025-08-11T11:31:20-04:00
Take more care in zonkEqTypes on AppTy/AppTy
This patch fixes #26256.
See Note [zonkEqTypes and the PKTI] in GHC.Tc.Solver.Equality
- - - - -
c8d76a29 by Zubin Duggal at 2025-08-11T11:32:02-04:00
ci: upgrade bootstrap compiler on windows to 9.10.1
- - - - -
eb410f1b by Recursion Ninja at 2025-08-11T13:08:58-04:00
Resolving issues #20645 and #26109
Correctly sign extending and casting smaller bit width types for LLVM operations:
- bitReverse8#
- bitReverse16#
- bitReverse32#
- byteSwap16#
- byteSwap32#
- pdep8#
- pdep16#
- pext8#
- pext16#
- - - - -
29 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Tc/Solver/Equality.hs
- docs/users_guide/conf.py
- docs/users_guide/expected-undocumented-flags.txt
- docs/users_guide/exts/doandifthenelse.rst
- + docs/users_guide/exts/relaxed_poly_rec.rst
- docs/users_guide/exts/types.rst
- libraries/ghc-internal/cbits/pdep.c
- libraries/ghc-internal/cbits/pext.c
- + testsuite/tests/llvm/should_run/T20645.hs
- + testsuite/tests/llvm/should_run/T20645.stdout
- testsuite/tests/llvm/should_run/all.T
- + testsuite/tests/numeric/should_compile/T26229.hs
- testsuite/tests/numeric/should_compile/all.T
- testsuite/tests/numeric/should_run/foundation.hs
- + testsuite/tests/partial-sigs/should_compile/T26256.hs
- + testsuite/tests/partial-sigs/should_compile/T26256.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- + testsuite/tests/typecheck/should_compile/T26256a.hs
- testsuite/tests/typecheck/should_compile/all.T
- utils/genprimopcode/Lexer.x
- utils/genprimopcode/Main.hs
- utils/genprimopcode/Parser.y
- utils/genprimopcode/ParserM.hs
- utils/genprimopcode/Syntax.hs
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -478,7 +478,7 @@ opsysVariables _ (Windows {}) = mconcat
, "LANG" =: "en_US.UTF-8"
, "CABAL_INSTALL_VERSION" =: "3.10.2.0"
, "HADRIAN_ARGS" =: "--docs=no-sphinx-pdfs"
- , "GHC_VERSION" =: "9.6.4"
+ , "GHC_VERSION" =: "9.10.1"
]
opsysVariables _ _ = mempty
=====================================
.gitlab/jobs.yaml
=====================================
@@ -3698,7 +3698,7 @@
"BUILD_FLAVOUR": "validate",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"LANG": "en_US.UTF-8",
@@ -3761,7 +3761,7 @@
"BUILD_FLAVOUR": "validate",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"LANG": "en_US.UTF-8",
@@ -5579,7 +5579,7 @@
"BUILD_FLAVOUR": "release",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"IGNORE_PERF_FAILURES": "all",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
@@ -5643,7 +5643,7 @@
"BUILD_FLAVOUR": "release",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"IGNORE_PERF_FAILURES": "all",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
@@ -7982,7 +7982,7 @@
"BUILD_FLAVOUR": "validate",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"LANG": "en_US.UTF-8",
@@ -8044,7 +8044,7 @@
"BUILD_FLAVOUR": "validate",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"LANG": "en_US.UTF-8",
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -148,6 +148,7 @@ defaults
vector = []
deprecated_msg = {} -- A non-empty message indicates deprecation
div_like = False -- Second argument expected to be non zero - used for tests
+ defined_bits = Nothing -- The number of bits the operation is defined for (if not all bits)
-- Note [When do out-of-line primops go in primops.txt.pp]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1065,8 +1066,10 @@ primop CtzOp "ctz#" GenPrimOp Word# -> Word#
primop BSwap16Op "byteSwap16#" GenPrimOp Word# -> Word#
{Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. }
+ with defined_bits = 16
primop BSwap32Op "byteSwap32#" GenPrimOp Word# -> Word#
{Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. }
+ with defined_bits = 32
primop BSwap64Op "byteSwap64#" GenPrimOp Word64# -> Word64#
{Swap bytes in a 64 bits of a word.}
primop BSwapOp "byteSwap#" GenPrimOp Word# -> Word#
@@ -1074,10 +1077,13 @@ primop BSwapOp "byteSwap#" GenPrimOp Word# -> Word#
primop BRev8Op "bitReverse8#" GenPrimOp Word# -> Word#
{Reverse the order of the bits in a 8-bit word.}
+ with defined_bits = 8
primop BRev16Op "bitReverse16#" GenPrimOp Word# -> Word#
{Reverse the order of the bits in a 16-bit word.}
+ with defined_bits = 16
primop BRev32Op "bitReverse32#" GenPrimOp Word# -> Word#
{Reverse the order of the bits in a 32-bit word.}
+ with defined_bits = 32
primop BRev64Op "bitReverse64#" GenPrimOp Word64# -> Word64#
{Reverse the order of the bits in a 64-bit word.}
primop BRevOp "bitReverse#" GenPrimOp Word# -> Word#
=====================================
compiler/GHC/Cmm/CommonBlockElim.hs
=====================================
@@ -29,6 +29,7 @@ import GHC.Utils.Word64 (truncateWord64ToWord32)
import Control.Arrow (first, second)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
+import GHC.Real (infinity,notANumber)
-- -----------------------------------------------------------------------------
-- Eliminate common blocks
@@ -167,7 +168,12 @@ hash_block block =
hash_lit :: CmmLit -> Word32
hash_lit (CmmInt i _) = fromInteger i
- hash_lit (CmmFloat r _) = truncate r
+ hash_lit (CmmFloat r _)
+ -- handle these special cases as `truncate` fails on non-fractional numbers (#26229)
+ | r == infinity = 9999999
+ | r == -infinity = 9999998
+ | r == notANumber = 6666666
+ | otherwise = truncate r
hash_lit (CmmVec ls) = hash_list hash_lit ls
hash_lit (CmmLabel _) = 119 -- ugh
hash_lit (CmmLabelOff _ i) = cvt $ 199 + i
=====================================
compiler/GHC/CmmToLlvm/CodeGen.hs
=====================================
@@ -230,23 +230,22 @@ genCall t@(PrimTarget (MO_Prefetch_Data localityInt)) [] args
statement $ Expr $ Call StdCall fptr (argVars' ++ argSuffix) []
| otherwise = panic $ "prefetch locality level integer must be between 0 and 3, given: " ++ (show localityInt)
--- Handle PopCnt, Clz, Ctz, and BSwap that need to only convert arg
--- and return types
-genCall t@(PrimTarget (MO_PopCnt w)) dsts args =
- genCallSimpleCast w t dsts args
-
-genCall t@(PrimTarget (MO_Pdep w)) dsts args =
- genCallSimpleCast2 w t dsts args
-genCall t@(PrimTarget (MO_Pext w)) dsts args =
- genCallSimpleCast2 w t dsts args
-genCall t@(PrimTarget (MO_Clz w)) dsts args =
- genCallSimpleCast w t dsts args
-genCall t@(PrimTarget (MO_Ctz w)) dsts args =
- genCallSimpleCast w t dsts args
-genCall t@(PrimTarget (MO_BSwap w)) dsts args =
- genCallSimpleCast w t dsts args
-genCall t@(PrimTarget (MO_BRev w)) dsts args =
- genCallSimpleCast w t dsts args
+-- Handle Clz, Ctz, BRev, BSwap, Pdep, Pext, and PopCnt that need to only
+-- convert arg and return types
+genCall (PrimTarget op@(MO_Clz w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_Ctz w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_BRev w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_BSwap w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_Pdep w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_Pext w)) [dst] args =
+ genCallSimpleCast w op dst args
+genCall (PrimTarget op@(MO_PopCnt w)) [dst] args =
+ genCallSimpleCast w op dst args
genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do
addrVar <- exprToVarW addr
@@ -640,63 +639,28 @@ genCallExtract _ _ _ _ =
-- since GHC only really has i32 and i64 types and things like Word8 are backed
-- by an i32 and just present a logical i8 range. So we must handle conversions
-- from i32 to i8 explicitly as LLVM is strict about types.
-genCallSimpleCast :: Width -> ForeignTarget -> [CmmFormal] -> [CmmActual]
- -> LlvmM StmtData
-genCallSimpleCast w t@(PrimTarget op) [dst] args = do
- let width = widthToLlvmInt w
- dstTy = cmmToLlvmType $ localRegType dst
-
- fname <- cmmPrimOpFunctions op
- (fptr, _, top3) <- getInstrinct fname width [width]
-
- (dstV, _dst_ty) <- getCmmReg (CmmLocal dst)
-
- let (_, arg_hints) = foreignTargetHints t
- let args_hints = zip args arg_hints
- (argsV, stmts2, top2) <- arg_vars args_hints ([], nilOL, [])
- (argsV', stmts4) <- castVars Signed $ zip argsV [width]
- (retV, s1) <- doExpr width $ Call StdCall fptr argsV' []
- (retVs', stmts5) <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)]
- let retV' = singletonPanic "genCallSimpleCast" retVs'
- let s2 = Store retV' dstV Nothing []
-
- let stmts = stmts2 `appOL` stmts4 `snocOL`
- s1 `appOL` stmts5 `snocOL` s2
- return (stmts, top2 ++ top3)
-genCallSimpleCast _ _ dsts _ =
- panic ("genCallSimpleCast: " ++ show (length dsts) ++ " dsts")
-
--- Handle simple function call that only need simple type casting, of the form:
--- truncate arg >>= \a -> call(a) >>= zext
---
--- since GHC only really has i32 and i64 types and things like Word8 are backed
--- by an i32 and just present a logical i8 range. So we must handle conversions
--- from i32 to i8 explicitly as LLVM is strict about types.
-genCallSimpleCast2 :: Width -> ForeignTarget -> [CmmFormal] -> [CmmActual]
- -> LlvmM StmtData
-genCallSimpleCast2 w t@(PrimTarget op) [dst] args = do
- let width = widthToLlvmInt w
- dstTy = cmmToLlvmType $ localRegType dst
-
- fname <- cmmPrimOpFunctions op
- (fptr, _, top3) <- getInstrinct fname width (const width <$> args)
-
- (dstV, _dst_ty) <- getCmmReg (CmmLocal dst)
-
- let (_, arg_hints) = foreignTargetHints t
- let args_hints = zip args arg_hints
- (argsV, stmts2, top2) <- arg_vars args_hints ([], nilOL, [])
- (argsV', stmts4) <- castVars Signed $ zip argsV (const width <$> argsV)
- (retV, s1) <- doExpr width $ Call StdCall fptr argsV' []
- (retVs', stmts5) <- castVars (cmmPrimOpRetValSignage op) [(retV,dstTy)]
- let retV' = singletonPanic "genCallSimpleCast2" retVs'
- let s2 = Store retV' dstV Nothing []
+genCallSimpleCast :: Width -> CallishMachOp -> CmmFormal -> [CmmActual]
+ -> LlvmM StmtData
+genCallSimpleCast specW op dst args = do
+ let width = widthToLlvmInt specW
+ argsW = const width <$> args
+ dstType = cmmToLlvmType $ localRegType dst
+ signage = cmmPrimOpRetValSignage op
+
+ fname <- cmmPrimOpFunctions op
+ (fptr, _, top3) <- getInstrinct fname width argsW
+ (dstV, _dst_ty) <- getCmmReg (CmmLocal dst)
+ let (_, arg_hints) = foreignTargetHints $ PrimTarget op
+ let args_hints = zip args arg_hints
+ (argsV, stmts2, top2) <- arg_vars args_hints ([], nilOL, [])
+ (argsV', stmts4) <- castVars signage $ zip argsV argsW
+ (retV, s1) <- doExpr width $ Call StdCall fptr argsV' []
+ (retV', stmts5) <- castVar signage retV dstType
+ let s2 = Store retV' dstV Nothing []
let stmts = stmts2 `appOL` stmts4 `snocOL`
- s1 `appOL` stmts5 `snocOL` s2
+ s1 `snocOL` stmts5 `snocOL` s2
return (stmts, top2 ++ top3)
-genCallSimpleCast2 _ _ dsts _ =
- panic ("genCallSimpleCast2: " ++ show (length dsts) ++ " dsts")
-- | Create a function pointer from a target.
getFunPtrW :: (LMString -> LlvmType) -> ForeignTarget
@@ -811,11 +775,47 @@ castVar signage v t | getVarType v == t
Signed -> LM_Sext
Unsigned -> LM_Zext
-
cmmPrimOpRetValSignage :: CallishMachOp -> Signage
cmmPrimOpRetValSignage mop = case mop of
- MO_Pdep _ -> Unsigned
- MO_Pext _ -> Unsigned
+ -- Some bit-wise operations /must/ always treat the input and output values
+ -- as 'Unsigned' in order to return the expected result values when pre/post-
+ -- operation bit-width truncation and/or extension occur. For example,
+ -- consider the Bit-Reverse operation:
+ --
+ -- If the result of a Bit-Reverse is treated as signed,
+ -- an positive input can result in an negative output, i.e.:
+ --
+ -- identity(0x03) = 0x03 = 00000011
+ -- breverse(0x03) = 0xC0 = 11000000
+ --
+ -- Now if an extension is performed after the operation to
+ -- promote a smaller bit-width value into a larger bit-width
+ -- type, it is expected that the /bit-wise/ operations will
+ -- not be treated /numerically/ as signed.
+ --
+ -- To illustrate the difference, consider how a signed extension
+ -- for the type i16 to i32 differs for out values above:
+ -- ext_zeroed(i32, breverse(0x03)) = 0x00C0 = 0000000011000000
+ -- ext_signed(i32, breverse(0x03)) = 0xFFC0 = 1111111111000000
+ --
+ -- Here we can see that the former output is the expected result
+ -- of a bit-wise operation which needs to be promoted to a larger
+ -- bit-width type. The latter output is not desirable when we must
+ -- constraining a value into a range of i16 within an i32 type.
+ --
+ -- Hence we always treat the "signage" as unsigned for Bit-Reverse!
+ --
+ -- The same reasoning applied to Bit-Reverse above applies to the other
+ -- bit-wise operations; do not sign extend a possibly negated number!
+ MO_BRev _ -> Unsigned
+ MO_BSwap _ -> Unsigned
+ MO_Clz _ -> Unsigned
+ MO_Ctz _ -> Unsigned
+ MO_Pdep _ -> Unsigned
+ MO_Pext _ -> Unsigned
+ MO_PopCnt _ -> Unsigned
+
+ -- All other cases, default to preserving the numeric sign when extending.
_ -> Signed
-- | Decide what C function to use to implement a CallishMachOp
=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -197,12 +197,8 @@ zonkEqTypes ev eq_rel ty1 ty2
then tycon tc1 tys1 tys2
else bale_out ty1 ty2
- go ty1 ty2
- | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1
- , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2
- = do { res_a <- go ty1a ty2a
- ; res_b <- go ty1b ty2b
- ; return $ combine_rev mkAppTy res_b res_a }
+ -- If you are temppted to add a case for AppTy/AppTy, be careful
+ -- See Note [zonkEqTypes and the PKTI]
go ty1@(LitTy lit1) (LitTy lit2)
| lit1 == lit2
@@ -278,6 +274,32 @@ zonkEqTypes ev eq_rel ty1 ty2
combine_rev f (Right tys) (Right ty) = Right (f ty tys)
+{- Note [zonkEqTypes and the PKTI]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Because `zonkEqTypes` does /partial/ zonking, we need to be very careful
+to maintain the Purely Kinded Type Invariant: see GHC.Tc.Gen/HsType
+HsNote [The Purely Kinded Type Invariant (PKTI)].
+
+In #26256 we try to solve this equality constraint:
+ Int :-> Maybe Char ~# k0 Int (m0 Char)
+where m0 and k0 are unification variables, and
+ m0 :: Type -> Type
+It happens that m0 was already unified
+ m0 := (w0 :: kappa)
+where kappa is another unification variable that is also already unified:
+ kappa := Type->Type.
+So the original type satisifed the PKTI, but a partially-zonked form
+ k0 Int (w0 Char)
+does not!! (This a bit reminiscent of Note [mkAppTyM].)
+
+The solution I have adopted is simply to make `zonkEqTypes` bale out on `AppTy`.
+After all, it's only supposed to be a quick hack to see if two types are already
+equal; if we bale out we'll just get into the "proper" canonicaliser.
+
+The only tricky thing about this approach is that it relies on /omitting/
+code -- for the AppTy/AppTy case! Hence this Note
+-}
+
{- *********************************************************************
* *
* canonicaliseEquality
=====================================
docs/users_guide/conf.py
=====================================
@@ -35,8 +35,6 @@ nitpick_ignore = [
("envvar", "TMPDIR"),
("c:type", "bool"),
-
- ("extension", "RelaxedPolyRec"),
]
rst_prolog = """
=====================================
docs/users_guide/expected-undocumented-flags.txt
=====================================
@@ -14,7 +14,6 @@
-XPolymorphicComponents
-XRecordPuns
-XRelaxedLayout
--XRelaxedPolyRec
-copy-libs-when-linking
-dannot-lint
-dppr-ticks
=====================================
docs/users_guide/exts/doandifthenelse.rst
=====================================
@@ -8,7 +8,7 @@ Do And If Then Else
:since: 7.0.1
- :status: Included in :extension:`Haskell2010`
+ :status: Included in :extension:`GHC2024`, :extension:`GHC2021`, :extension:`Haskell2010`
Allow semicolons in ``if`` expressions.
=====================================
docs/users_guide/exts/relaxed_poly_rec.rst
=====================================
@@ -0,0 +1,17 @@
+.. _relaxed-poly-rec:
+
+Generalised typing of mutually recursive bindings
+-------------------------------------------------
+
+.. extension:: RelaxedPolyRec
+ :shortdesc: Generalised typing of mutually recursive bindings.
+
+ :since: 6.8.1
+
+ :status: Included in :extension:`GHC2024`, :extension:`GHC2021`, :extension:`Haskell2010`
+
+See :ref:`infelicities-recursive-groups` for a description of this extension.
+This is a long-standing GHC extension. Around the time of GHC 7.6.3, this
+extension became required as part of a typechecker refactoring.
+The ``-XRelaxedPolyRec`` flag is now deprecated (since the feature is always
+enabled) and may be removed at some future time.
=====================================
docs/users_guide/exts/types.rst
=====================================
@@ -30,3 +30,4 @@ Types
type_errors
defer_type_errors
roles
+ relaxed_poly_rec
=====================================
libraries/ghc-internal/cbits/pdep.c
=====================================
@@ -24,20 +24,23 @@ hs_pdep64(StgWord64 src, StgWord64 mask)
return result;
}
+// When dealing with values of bit-width shorter than uint64_t, ensure to
+// cast the return value to correctly truncate the undefined upper bits.
+// This is *VERY* important when GHC is using the LLVM backend!
StgWord
hs_pdep32(StgWord src, StgWord mask)
{
- return hs_pdep64(src, mask);
+ return (StgWord) ((StgWord32) hs_pdep64(src, mask));
}
StgWord
hs_pdep16(StgWord src, StgWord mask)
{
- return hs_pdep64(src, mask);
+ return (StgWord) ((StgWord16) hs_pdep64(src, mask));
}
StgWord
hs_pdep8(StgWord src, StgWord mask)
{
- return hs_pdep64(src, mask);
+ return (StgWord) ((StgWord8) hs_pdep64(src, mask));
}
=====================================
libraries/ghc-internal/cbits/pext.c
=====================================
@@ -1,13 +1,13 @@
#include "Rts.h"
#include "MachDeps.h"
-StgWord64
-hs_pext64(StgWord64 src, StgWord64 mask)
+static StgWord64
+hs_pext(const unsigned char bit_width, const StgWord64 src, const StgWord64 mask)
{
uint64_t result = 0;
int offset = 0;
- for (int bit = 0; bit != sizeof(uint64_t) * 8; ++bit) {
+ for (int bit = 0; bit != bit_width; ++bit) {
const uint64_t src_bit = (src >> bit) & 1;
const uint64_t mask_bit = (mask >> bit) & 1;
@@ -20,20 +20,29 @@ hs_pext64(StgWord64 src, StgWord64 mask)
return result;
}
+StgWord64
+hs_pext64(const StgWord64 src, const StgWord64 mask)
+{
+ return hs_pext(64, src, mask);
+}
+
+// When dealing with values of bit-width shorter than uint64_t, ensure to
+// cast the return value to correctly truncate the undefined upper bits.
+// This is *VERY* important when GHC is using the LLVM backend!
StgWord
-hs_pext32(StgWord src, StgWord mask)
+hs_pext32(const StgWord src, const StgWord mask)
{
- return hs_pext64(src, mask);
+ return (StgWord) ((StgWord32) hs_pext(32, src, mask));
}
StgWord
-hs_pext16(StgWord src, StgWord mask)
+hs_pext16(const StgWord src, const StgWord mask)
{
- return hs_pext64(src, mask);
+ return (StgWord) ((StgWord16) hs_pext(16, src, mask));
}
StgWord
-hs_pext8(StgWord src, StgWord mask)
+hs_pext8(const StgWord src, const StgWord mask)
{
- return hs_pext64(src, mask);
+ return (StgWord) ((StgWord8) hs_pext(8, src, mask));
}
=====================================
testsuite/tests/llvm/should_run/T20645.hs
=====================================
@@ -0,0 +1,18 @@
+-- Minimal reproducer for https://gitlab.haskell.org/ghc/ghc/-/issues/20645
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ExtendedLiterals #-}
+import GHC.Exts
+import GHC.Word
+import Numeric (showHex)
+
+opaqueInt8# :: Int8# -> Int8#
+opaqueInt8# x = x
+{-# OPAQUE opaqueInt8# #-}
+
+main :: IO ()
+main = let !x = opaqueInt8# 109#Int8
+ !y = opaqueInt8# 1#Int8
+ in putStrLn $ flip showHex "" (W# ( pext8#
+ (word8ToWord# (int8ToWord8# (0#Int8 `subInt8#` x )))
+ (word8ToWord# (int8ToWord8# (y `subInt8#` 4#Int8)))
+ ))
=====================================
testsuite/tests/llvm/should_run/T20645.stdout
=====================================
@@ -0,0 +1 @@
+49
=====================================
testsuite/tests/llvm/should_run/all.T
=====================================
@@ -17,3 +17,4 @@ test('T22487', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_a
test('T22033', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, [''])
test('T25730', [req_c, unless(arch('x86_64'), skip), normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, ['T25730C.c'])
# T25730C.c contains Intel instrinsics, so only run this test on x86
+test('T20645', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"]))], compile_and_run, [''])
=====================================
testsuite/tests/numeric/should_compile/T26229.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE NegativeLiterals #-}
+
+module T26229 where
+
+sqrte2pqiq :: (Floating a, Ord a) => a -> a -> a
+sqrte2pqiq e qiq -- = sqrt (e*e + qiq)
+ | e < - 1.5097698010472593e153 = -(qiq/e) - e
+ | e < 5.582399551122541e57 = sqrt (e*e + qiq) -- test Infinity#
+ | e < -5.582399551122541e57 = -sqrt (e*e + qiq) -- test -Infinity#
+ | otherwise = (qiq/e) + e
+{-# SPECIALIZE sqrte2pqiq :: Double -> Double -> Double #-}
+{-# SPECIALIZE sqrte2pqiq :: Float -> Float -> Float #-}
=====================================
testsuite/tests/numeric/should_compile/all.T
=====================================
@@ -22,3 +22,4 @@ test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b
test('T23019', normal, compile, ['-O'])
test('T23907', [ when(wordsize(32), expect_broken(23908))], compile, ['-ddump-simpl -O2 -dsuppress-all -dno-typeable-binds -dsuppress-uniques'])
test('T24331', normal, compile, ['-O -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds'])
+test('T26229', normal, compile, ['-O2'])
=====================================
testsuite/tests/numeric/should_run/foundation.hs
=====================================
@@ -24,6 +24,7 @@ module Main
( main
) where
+import Data.Bits (Bits((.&.), bit))
import Data.Word
import Data.Int
import GHC.Natural
@@ -408,6 +409,33 @@ instance TestPrimop (Word# -> Int# -> Word#) where
testPrimop s l r = Property s $ \(uWord -> a1) (uInt -> a2) -> (wWord (l a1 a2)) === wWord (r a1 a2)
-}
+-- | A special data-type for representing functions where,
+-- since only some number of the lower bits are defined,
+-- testing for strict equality in the undefined upper bits is not appropriate!
+-- Without using this data-type, false-positive failures will be reported
+-- when the undefined bit regions do not match, even though the equality of bits
+-- in this undefined region has no bearing on correctness.
+data LowerBitsAreDefined =
+ LowerBitsAreDefined
+ { definedLowerWidth :: Word
+ -- ^ The (strictly-non-negative) number of least-significant bits
+ -- for which the attached function is defined.
+ , undefinedBehavior :: (Word# -> Word#)
+ -- ^ Function with undefined behavior for some of its most significant bits.
+ }
+
+instance TestPrimop LowerBitsAreDefined where
+ testPrimop s l r = Property s $ \ (uWord#-> x0) ->
+ let -- Create a mask to unset all bits in the undefined area,
+ -- leaving set bits only in the area of defined behavior.
+ -- Since the upper bits are undefined,
+ -- if the function defines behavior for the lower N bits,
+ -- then /only/ the lower N bits are preserved,
+ -- and the upper WORDSIZE - N bits are discarded.
+ mask = bit (fromEnum (definedLowerWidth r)) - 1
+ valL = wWord# (undefinedBehavior l x0) .&. mask
+ valR = wWord# (undefinedBehavior r x0) .&. mask
+ in valL === valR
twoNonZero :: (a -> a -> b) -> a -> NonZero a -> b
twoNonZero f x (NonZero y) = f x y
@@ -655,13 +683,13 @@ testPrimops = Group "primop"
, testPrimop "ctz32#" Primop.ctz32# Wrapper.ctz32#
, testPrimop "ctz64#" Primop.ctz64# Wrapper.ctz64#
, testPrimop "ctz#" Primop.ctz# Wrapper.ctz#
- , testPrimop "byteSwap16#" Primop.byteSwap16# Wrapper.byteSwap16#
- , testPrimop "byteSwap32#" Primop.byteSwap32# Wrapper.byteSwap32#
+ , testPrimop "byteSwap16#" (16 `LowerBitsAreDefined` Primop.byteSwap16#) (16 `LowerBitsAreDefined` Wrapper.byteSwap16#)
+ , testPrimop "byteSwap32#" (32 `LowerBitsAreDefined` Primop.byteSwap32#) (32 `LowerBitsAreDefined` Wrapper.byteSwap32#)
, testPrimop "byteSwap64#" Primop.byteSwap64# Wrapper.byteSwap64#
, testPrimop "byteSwap#" Primop.byteSwap# Wrapper.byteSwap#
- , testPrimop "bitReverse8#" Primop.bitReverse8# Wrapper.bitReverse8#
- , testPrimop "bitReverse16#" Primop.bitReverse16# Wrapper.bitReverse16#
- , testPrimop "bitReverse32#" Primop.bitReverse32# Wrapper.bitReverse32#
+ , testPrimop "bitReverse8#" (8 `LowerBitsAreDefined` Primop.bitReverse8#) (8 `LowerBitsAreDefined` Wrapper.bitReverse8#)
+ , testPrimop "bitReverse16#" (16 `LowerBitsAreDefined` Primop.bitReverse16#) (16 `LowerBitsAreDefined` Wrapper.bitReverse16#)
+ , testPrimop "bitReverse32#" (32 `LowerBitsAreDefined` Primop.bitReverse32#) (32 `LowerBitsAreDefined` Wrapper.bitReverse32#)
, testPrimop "bitReverse64#" Primop.bitReverse64# Wrapper.bitReverse64#
, testPrimop "bitReverse#" Primop.bitReverse# Wrapper.bitReverse#
, testPrimop "narrow8Int#" Primop.narrow8Int# Wrapper.narrow8Int#
=====================================
testsuite/tests/partial-sigs/should_compile/T26256.hs
=====================================
@@ -0,0 +1,23 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+
+module M (go) where
+
+import Data.Kind
+
+type Apply :: (Type -> Type) -> Type
+data Apply m
+
+type (:->) :: Type -> Type -> Type
+type family (:->) where (:->) = (->)
+
+f :: forall (k :: Type -> Type -> Type) (m :: Type -> Type).
+ k Int (m Char) -> k Bool (Apply m)
+f = f
+
+x :: Int :-> Maybe Char
+x = x
+
+go :: Bool -> _ _
+go = f x
=====================================
testsuite/tests/partial-sigs/should_compile/T26256.stderr
=====================================
@@ -0,0 +1,8 @@
+T26256.hs:22:15: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘Apply :: (* -> *) -> *’
+ • In the type signature: go :: Bool -> _ _
+
+T26256.hs:22:17: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘Maybe :: * -> *’
+ • In the first argument of ‘_’, namely ‘_’
+ In the type signature: go :: Bool -> _ _
=====================================
testsuite/tests/partial-sigs/should_compile/all.T
=====================================
@@ -108,3 +108,4 @@ test('T21667', normal, compile, [''])
test('T22065', normal, compile, [''])
test('T16152', normal, compile, [''])
test('T20076', expect_broken(20076), compile, [''])
+test('T26256', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_compile/T26256a.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T26256 (go) where
+
+import Data.Kind
+
+class Cat k where (<<<) :: k a b -> k x a -> k x b
+instance Cat (->) where (<<<) = (.)
+class Pro k p where pro :: k a b s t -> p a b -> p s t
+data Hiding o a b s t = forall e. Hiding (s -> o e a)
+newtype Apply e a = Apply (e a)
+
+type (:->) :: Type -> Type -> Type
+type family (:->) where
+ (:->) = (->)
+
+go :: (Pro (Hiding Apply) p) => (s :-> e a) -> p a b -> p s t
+go sea = pro (Hiding (Apply <<< sea))
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -940,3 +940,4 @@ test('T26020', normal, compile, [''])
test('T26020a', [extra_files(['T26020a_help.hs'])], multimod_compile, ['T26020a', '-v0'])
test('T25992', normal, compile, [''])
test('T14010', normal, compile, [''])
+test('T26256a', normal, compile, [''])
=====================================
utils/genprimopcode/Lexer.x
=====================================
@@ -56,6 +56,7 @@ words :-
<0> "CanFail" { mkT TCanFail }
<0> "ThrowsException" { mkT TThrowsException }
<0> "ReadWriteEffect" { mkT TReadWriteEffect }
+ <0> "defined_bits" { mkT TDefinedBits }
<0> "can_fail_warning" { mkT TCanFailWarnFlag }
<0> "DoNotWarnCanFail" { mkT TDoNotWarnCanFail }
<0> "WarnIfEffectIsCanFail" { mkT TWarnIfEffectIsCanFail }
=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -10,6 +10,7 @@ module Main where
import Parser
import Syntax
+import Control.Applicative (asum)
import Data.Char
import Data.List (union, intersperse, intercalate, nub, sort)
import Data.Maybe ( catMaybes, mapMaybe )
@@ -116,9 +117,15 @@ desugarVectorSpec i = case vecOptions i of
main :: IO ()
main = getArgs >>= \args ->
if length args /= 1 || head args `notElem` known_args
- then error ("usage: genprimopcode command < primops.txt > ...\n"
+ then error ("Usage: genprimopcode command < primops.txt > ...\n"
++ " where command is one of\n"
++ unlines (map (" "++) known_args)
+ ++ unlines
+ [ ""
+ , "Nota Bene: Be sure to manually run primops.txt through the C Pre-Processor"
+ , " before sending the input stream to STDIN, i.e:"
+ , ""
+ , " cpp -P -w primops.txt | genprimopcode command" ]
)
else
do hSetEncoding stdin utf8 -- The input file is in UTF-8. Set the encoding explicitly.
@@ -312,6 +319,7 @@ gen_hs_source (Info defaults entries) =
opt (OptionVector _) = ""
opt (OptionFixity mf) = "fixity = " ++ show mf
opt (OptionEffect eff) = "effect = " ++ show eff
+ opt (OptionDefinedBits bc) = "defined_bits = " ++ show bc
opt (OptionCanFailWarnFlag wf) = "can_fail_warning = " ++ show wf
hdr s@(Section {}) = sec s
@@ -638,6 +646,7 @@ gen_switch_from_attribs attrib_name fn_name (Info defaults entries)
getAltRhs (OptionVector _) = "True"
getAltRhs (OptionFixity mf) = show mf
getAltRhs (OptionEffect eff) = show eff
+ getAltRhs (OptionDefinedBits bc) = show bc
getAltRhs (OptionCanFailWarnFlag wf) = show wf
mkAlt po
@@ -753,7 +762,12 @@ gen_foundation_tests (Info _ entries)
= let testPrimOpHow = if is_divLikeOp po
then "testPrimopDivLike"
else "testPrimop"
- in Just $ intercalate " " [testPrimOpHow, "\"" ++ poName ++ "\"", wrap "Primop" poName, wrap "Wrapper" poName]
+ qualOp qualification =
+ let qName = wrap qualification poName
+ in case mb_defined_bits po of
+ Nothing -> qName
+ Just bs -> concat ["(", show bs, " `LowerBitsAreDefined` ", qName, ")"]
+ in Just $ intercalate " " [testPrimOpHow, "\"" ++ poName ++ "\"", qualOp "Primop", qualOp "Wrapper"]
| otherwise = Nothing
@@ -771,6 +785,16 @@ gen_foundation_tests (Info _ entries)
divableTyCons = ["Int#", "Word#", "Word8#", "Word16#", "Word32#", "Word64#"
,"Int8#", "Int16#", "Int32#", "Int64#"]
+ mb_defined_bits :: Entry -> Maybe Word
+ mb_defined_bits op@(PrimOpSpec{}) =
+ let opOpts = opts op
+ getDefBits :: Option -> Maybe Word
+ getDefBits (OptionDefinedBits x) = x
+ getDefBits _ = Nothing
+ in asum $ getDefBits <$> opOpts
+ mb_defined_bits _ = Nothing
+
+
------------------------------------------------------------------
-- Create PrimOpInfo text from PrimOpSpecs -----------------------
------------------------------------------------------------------
=====================================
utils/genprimopcode/Parser.y
=====================================
@@ -50,6 +50,7 @@ import AccessOps
CanFail { TCanFail }
ThrowsException { TThrowsException }
ReadWriteEffect { TReadWriteEffect }
+ defined_bits { TDefinedBits }
can_fail_warning { TCanFailWarnFlag }
DoNotWarnCanFail { TDoNotWarnCanFail }
WarnIfEffectIsCanFail { TWarnIfEffectIsCanFail }
@@ -81,13 +82,14 @@ pOptions : pOption pOptions { $1 : $2 }
| {- empty -} { [] }
pOption :: { Option }
-pOption : lowerName '=' false { OptionFalse $1 }
- | lowerName '=' true { OptionTrue $1 }
- | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
- | lowerName '=' integer { OptionInteger $1 $3 }
- | vector '=' pVectorTemplate { OptionVector $3 }
- | fixity '=' pInfix { OptionFixity $3 }
- | effect '=' pEffect { OptionEffect $3 }
+pOption : lowerName '=' false { OptionFalse $1 }
+ | lowerName '=' true { OptionTrue $1 }
+ | lowerName '=' pStuffBetweenBraces { OptionString $1 $3 }
+ | lowerName '=' integer { OptionInteger $1 $3 }
+ | vector '=' pVectorTemplate { OptionVector $3 }
+ | fixity '=' pInfix { OptionFixity $3 }
+ | effect '=' pEffect { OptionEffect $3 }
+ | defined_bits '=' pGoodBits { OptionDefinedBits $3 }
| can_fail_warning '=' pPrimOpCanFailWarnFlag { OptionCanFailWarnFlag $3 }
pInfix :: { Maybe Fixity }
@@ -102,6 +104,10 @@ pEffect : NoEffect { NoEffect }
| ThrowsException { ThrowsException }
| ReadWriteEffect { ReadWriteEffect }
+pGoodBits :: { Maybe Word }
+pGoodBits : integer { Just $ toEnum $1 }
+ | nothing { Nothing }
+
pPrimOpCanFailWarnFlag :: { PrimOpCanFailWarnFlag }
pPrimOpCanFailWarnFlag : DoNotWarnCanFail { DoNotWarnCanFail }
| WarnIfEffectIsCanFail { WarnIfEffectIsCanFail }
=====================================
utils/genprimopcode/ParserM.hs
=====================================
@@ -116,6 +116,7 @@ data Token = TEOF
| TCanFail
| TThrowsException
| TReadWriteEffect
+ | TDefinedBits
| TCanFailWarnFlag
| TDoNotWarnCanFail
| TWarnIfEffectIsCanFail
=====================================
utils/genprimopcode/Syntax.hs
=====================================
@@ -76,6 +76,7 @@ data Option
| OptionFixity (Maybe Fixity) -- fixity = infix{,l,r} <int> | Nothing
| OptionEffect PrimOpEffect -- effect = NoEffect | DoNotSpeculate | CanFail | ThrowsException | ReadWriteEffect | FallibleReadWriteEffect
| OptionCanFailWarnFlag PrimOpCanFailWarnFlag -- can_fail_warning = DoNotWarnCanFail | WarnIfEffectIsCanFail | YesWarnCanFail
+ | OptionDefinedBits (Maybe Word) -- defined_bits = Just 16 | Nothing
deriving Show
-- categorises primops
@@ -196,6 +197,7 @@ get_attrib_name (OptionVector _) = "vector"
get_attrib_name (OptionFixity _) = "fixity"
get_attrib_name (OptionEffect _) = "effect"
get_attrib_name (OptionCanFailWarnFlag _) = "can_fail_warning"
+get_attrib_name (OptionDefinedBits _) = "defined_bits"
lookup_attrib :: String -> [Option] -> Maybe Option
lookup_attrib _ [] = Nothing
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01be20d3762af6fe8df718cb86788c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01be20d3762af6fe8df718cb86788c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/spj-apporv-Oct24] 2 commits: notes and misc changes
by Apoorv Ingle (@ani) 11 Aug '25
by Apoorv Ingle (@ani) 11 Aug '25
11 Aug '25
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
f6b42024 by Apoorv Ingle at 2025-08-11T11:02:36-05:00
notes and misc changes
- - - - -
90a013ab by Apoorv Ingle at 2025-08-11T11:25:12-05:00
rename ea_ctxt -> ea_loc_span eaql_ctx -> eaql_loc_span
- - - - -
7 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Utils/Monad.hs
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -675,11 +675,11 @@ type instance XXExpr GhcTc = XXExprGhcTc
data SrcCodeOrigin
= OrigExpr (HsExpr GhcRn) -- ^ The source, user written, expression
| OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from
- | OrigPat (Pat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints
+ | OrigPat (Pat GhcRn) -- ^ Used for failable patterns that trigger MonadFail constraints
data XXExprGhcRn
- = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages
- , xrn_expanded :: HsExpr GhcRn -- The compiler generated expanded thing
+ = ExpandedThingRn { xrn_orig :: SrcCodeOrigin -- The original source thing to be used for error messages
+ , xrn_expanded :: HsExpr GhcRn -- The compiler generated, expanded thing
}
| PopErrCtxt -- A hint for typechecker to pop
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -544,17 +544,18 @@ tcValArgs do_ql fun args = go do_ql 0 args
go do_ql pos (arg : args) =
do { arg' <- tcValArg do_ql pos' fun arg
; args' <- go do_ql pos' args
- ; return (arg' : args')
- }
+ ; return (arg' : args') }
where
-- increment position if the argument is user written type or value argument
pos' | EValArg{} <- arg
= pos + 1
| EValArgQL{} <- arg
= pos + 1
- | ETypeArg{ ea_ctxt = l } <- arg
- , not (isGeneratedSrcSpan l) = pos + 1
- | otherwise = pos
+ | ETypeArg{ ea_loc_span = l } <- arg
+ , not (isGeneratedSrcSpan l)
+ = pos + 1
+ | otherwise
+ = pos
tcValArg :: QLFlag -> Int -> HsExpr GhcRn -> HsExprArg 'TcpInst -- Actual argument
@@ -566,7 +567,7 @@ tcValArg do_ql _ _ (EWrap (EHsWrap w)) = do { whenQL do_ql $ qlMonoHsWrapper w
-- qlMonoHsWrapper: see Note [Monomorphise instantiation variables]
tcValArg _ _ _ (EWrap ew) = return (EWrap ew)
-tcValArg do_ql pos fun (EValArg { ea_ctxt = ctxt
+tcValArg do_ql pos fun (EValArg { ea_loc_span = ctxt
, ea_arg = larg@(L arg_loc arg)
, ea_arg_ty = sc_arg_ty })
= addArgCtxt pos fun larg $
@@ -594,20 +595,21 @@ tcValArg do_ql pos fun (EValArg { ea_ctxt = ctxt
tcPolyExpr arg (mkCheckExpType exp_arg_ty)
; traceTc "tcValArg" $ vcat [ ppr arg'
, text "}" ]
- ; return (EValArg { ea_ctxt = ctxt
+ ; return (EValArg { ea_loc_span = ctxt
, ea_arg = L arg_loc arg'
, ea_arg_ty = noExtField }) }
-tcValArg _ pos fun (EValArgQL { eaql_wanted = wanted
- , eaql_ctxt = ctxt
- , eaql_arg_ty = sc_arg_ty
- , eaql_larg = larg@(L arg_loc rn_expr)
- , eaql_tc_fun = tc_head
- , eaql_rn_fun = rn_fun
- , eaql_fun_ue = head_ue
- , eaql_args = inst_args
- , eaql_encl = arg_influences_enclosing_call
- , eaql_res_rho = app_res_rho })
+tcValArg _ pos fun (EValArgQL {
+ eaql_wanted = wanted
+ , eaql_loc_span = ctxt
+ , eaql_arg_ty = sc_arg_ty
+ , eaql_larg = larg@(L arg_loc rn_expr)
+ , eaql_tc_fun = tc_head
+ , eaql_rn_fun = rn_fun
+ , eaql_fun_ue = head_ue
+ , eaql_args = inst_args
+ , eaql_encl = arg_influences_enclosing_call
+ , eaql_res_rho = app_res_rho })
= addArgCtxt pos fun larg $
do { -- Expose QL results to tcSkolemise, as in EValArg case
Scaled mult exp_arg_ty <- liftZonkM $ zonkScaledTcType sc_arg_ty
@@ -644,7 +646,7 @@ tcValArg _ pos fun (EValArgQL { eaql_wanted = wanted
; traceTc "tcEValArgQL }" $
vcat [ text "app_res_rho:" <+> ppr app_res_rho ]
- ; return (EValArg { ea_ctxt = ctxt
+ ; return (EValArg { ea_loc_span = ctxt
, ea_arg = L arg_loc (mkHsWrap wrap arg')
, ea_arg_ty = noExtField }) }
@@ -814,10 +816,10 @@ tcInstFun do_ql inst_final fun_orig (tc_fun, rn_fun, fun_ctxt) fun_sigma rn_args
= go1 pos (EPrag sp prag : acc) fun_ty args
-- Rule ITYARG from Fig 4 of the QL paper
- go1 pos acc fun_ty ( ETypeArg { ea_ctxt = ctxt, ea_hs_ty = hs_ty }
+ go1 pos acc fun_ty ( ETypeArg { ea_loc_span = ctxt, ea_hs_ty = hs_ty }
: rest_args )
= do { (ty_arg, inst_ty) <- tcVTA fun_conc_tvs fun_ty hs_ty
- ; let arg' = ETypeArg { ea_ctxt = ctxt, ea_hs_ty = hs_ty, ea_ty_arg = ty_arg }
+ ; let arg' = ETypeArg { ea_loc_span = ctxt, ea_hs_ty = hs_ty, ea_ty_arg = ty_arg }
; go pos (arg' : acc) inst_ty rest_args }
-- Rule IVAR from Fig 4 of the QL paper:
@@ -857,7 +859,7 @@ tcInstFun do_ql inst_final fun_orig (tc_fun, rn_fun, fun_ctxt) fun_sigma rn_args
-- Rule IARG from Fig 4 of the QL paper:
go1 pos acc fun_ty
- (EValArg { ea_arg = arg, ea_ctxt = ctxt } : rest_args)
+ (EValArg { ea_arg = arg, ea_loc_span = ctxt } : rest_args)
= do { let herald = mk_herald tc_fun (unLoc arg)
; (wrap, arg_ty, res_ty) <-
-- NB: matchActualFunTy does the rep-poly check.
@@ -924,9 +926,9 @@ addArgCtxt :: Int -> HsExpr GhcRn -> LHsExpr GhcRn
-- There are 2 cases:
-- 1. In the normal case, we add an informative context
-- "In the third argument of f, namely blah"
--- 2. If we are deep inside generated code (`isGeneratedCode` is `True`)
+-- 2. If we are deep inside generated code (<=> `isGeneratedCode` is `True`)
-- "In the expression: arg"
--- If the arg is also a generated thing, i.e. arg_loc is generatedSrcSpan, we would print do nothing.
+-- If the arg is also a generated thing, i.e. `arg_loc` is `generatedSrcSpan`, we would print nothing.
-- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
-- See Note [Expanding HsDo with XXExprGhcRn] in GHC.Tc.Gen.Do
addArgCtxt arg_no fun (L arg_loc arg) thing_inside
@@ -1733,7 +1735,7 @@ quickLookArg DoQL pos ctxt fun larg orig_arg_ty
skipQuickLook :: SrcSpan -> LHsExpr GhcRn -> Scaled TcRhoType
-> TcM (HsExprArg 'TcpInst)
skipQuickLook ctxt larg arg_ty
- = return (EValArg { ea_ctxt = ctxt
+ = return (EValArg { ea_loc_span = ctxt
, ea_arg = larg
, ea_arg_ty = arg_ty })
@@ -1834,16 +1836,16 @@ quickLookArg1 pos ctxt fun larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_rho)
; traceTc "quickLookArg done }" (ppr rn_fun)
- ; return (EValArgQL { eaql_ctxt = ctxt
- , eaql_arg_ty = sc_arg_ty
- , eaql_larg = larg
- , eaql_tc_fun = tc_head
- , eaql_rn_fun = rn_fun
- , eaql_fun_ue = fun_ue
- , eaql_args = inst_args
- , eaql_wanted = wanted
- , eaql_encl = arg_influences_enclosing_call
- , eaql_res_rho = app_res_rho }) }}}
+ ; return (EValArgQL { eaql_loc_span = ctxt
+ , eaql_arg_ty = sc_arg_ty
+ , eaql_larg = larg
+ , eaql_tc_fun = tc_head
+ , eaql_rn_fun = rn_fun
+ , eaql_fun_ue = fun_ue
+ , eaql_args = inst_args
+ , eaql_wanted = wanted
+ , eaql_encl = arg_influences_enclosing_call
+ , eaql_res_rho = app_res_rho }) }}}
{- *********************************************************************
* *
=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -75,7 +75,7 @@ expand_do_stmts _ (stmt@(L _ (XStmtLR ApplicativeStmt{})): _) =
expand_do_stmts _ [] = pprPanic "expand_do_stmts: impossible happened. Empty stmts" empty
-expand_do_stmts flav [stmt@(L sloc (LastStmt _ body@(L body_loc _) _ ret_expr))]
+expand_do_stmts _flav [_stmt@(L _sloc (LastStmt _ body@(L body_loc _) _ ret_expr))]
-- See Note [Expanding HsDo with XXExprGhcRn] Equation (5) below
-- last statement of a list comprehension, needs to explicitly return it
-- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt`
@@ -83,7 +83,7 @@ expand_do_stmts flav [stmt@(L sloc (LastStmt _ body@(L body_loc _) _ ret_expr))]
-- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt
-- = return $ L sloc (mkExpandedStmt stmt flav (HsPar noExtField body))
= return body
- | SyntaxExprRn ret <- ret_expr
+ | SyntaxExprRn ret <- ret_expr -- We have unfortunately lost the location on the return function :(
--
-- ------------------------------------------------
-- return e ~~> return e
@@ -230,7 +230,7 @@ mk_fail_block _ _ _ _ = pprPanic "mk_fail_block: impossible happened" empty
{- Note [Expanding HsDo with XXExprGhcRn]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We expand `do`-blocks before typechecking it, by re-using the existing `XXExprGhcRns` and `RebindableSyntax` machinery.
+We expand `do`-blocks before typechecking it, by re-using the existing `XXExprGhcRn` and `RebindableSyntax` machinery.
This is very similar to:
1. Expansions done in `GHC.Rename.Expr.rnHsIf` for expanding `HsIf`; and
2. `desugarRecordUpd` in `GHC.Tc.Gen.Expr.tcExpr` for expanding `RecordUpd`
@@ -275,14 +275,15 @@ They capture the essence of statement expansions as implemented in `expand_do_st
DO【 _ 】 maps a sequence of do statements and recursively converts them into expressions
- (1) DO【 s; ss 】 = ‹ExpansionStmt s›((>>) s (‹PopErrCtxt›DO【 ss 】))
+ (1) DO【 s; ss 】 = ‹ExpansionStmt s›((>>) (‹PopErrCtxt› s) (‹PopErrCtxt› DO【 ss 】))
(2) DO【 p <- e; ss 】 = if p is irrefutable
then ‹ExpansionStmt (p <- e)›
- (>>=) s ((\ p -> ‹PopExprCtxt› DO【 ss 】))
+ (>>=) (‹PopExprCtxt› s) ((\ p -> ‹PopExprCtxt› DO【 ss 】))
else ‹ExpansionStmt (p <- e)›
- (>>=) s ((\case p -> ‹PopExprCtxt› DO【 ss 】
- _ -> fail "pattern p failure"))
+ (>>=) (‹PopExprCtxt› s)
+ (\case p -> ‹PopExprCtxt› DO【 ss 】
+ _ -> fail "pattern p failure")
(3) DO【 let x = e; ss 】
= ‹ExpansionStmt (let x = e)› (let x = e in (‹PopErrCtxt›DO【 ss 】))
@@ -313,8 +314,8 @@ The expanded version (performed by `expand_do_stmts`) looks like:
{g2} (>>) ({l2} g p)
({l3} return p))
-The {l1} etc are location/source span information stored in the AST by the parser,
-{g1} are compiler generated source spans.
+The {l1}, {l2}, etc. are the location/source span information stored in the AST by the parser,
+{g1}, {g2}, etc. are the compiler generated source spans.
The 3 non-obvious points to consider are:
@@ -427,10 +428,10 @@ It stores the original statement (with location) and the expanded expression
‹ExpandedThingRn do { e1; e2; e3 }› -- Original Do Expression
-- Expanded Do Expression
(‹ExpandedThingRn e1› -- Original Statement
- ({(>>) e1} -- Expanded Expression
- ‹PopErrCtxt› (‹ExpandedThingRn e2›
- ({(>>) e2}
- ‹PopErrCtxt› (‹ExpandedThingRn e3› {e3})))))
+ ({(>>) ‹PopErrCtxt› e1} -- Expanded Expression
+ ‹PopErrCtxt› (‹ExpandedThingRn e2›
+ ({(>>) ‹PopErrCtxt› e2}
+ ‹PopErrCtxt› (‹ExpandedThingRn e3› {e3})))))
* Whenever the typechecker steps through an `ExpandedThingRn`,
we push the original statement in the error context, set the error location to the
@@ -445,7 +446,7 @@ It stores the original statement (with location) and the expanded expression
as precise as possible, and not just blame the complete `do`-block.
Thus, when we typecheck the application `(>>) e1`, we push the "In the stmt of do block e1" with
the source location of `e1` in the error context stack as we walk inside an `ExpandedThingRn`.
- See also Note [splitHsApps].
+ See also Note [splitHsApps] and Note [Error Context Stack]
* After the expanded expression of a `do`-statement is typechecked
and before moving to the next statement of the `do`-block, we need to first pop the top
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -648,9 +648,9 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr
res_ty
= assert (notNull rbnds) $
do { -- Expand the record update. See Note [Record Updates].
- ; (ds_expr, ds_res_ty, err_ctxt)
+ ; (ds_expr, ds_res_ty, err_msg)
<- expandRecordUpd record_expr possible_parents rbnds res_ty
- ; addErrCtxt err_ctxt $
+ ; addErrCtxt err_msg $
setInGeneratedCode (OrigExpr expr) $
do { -- Typecheck the expanded expression.
expr' <- tcExpr ds_expr (Check ds_res_ty)
@@ -748,9 +748,11 @@ tcXExpr (PopErrCtxt e) res_ty
tcExpr e res_ty
tcXExpr (ExpandedThingRn o e) res_ty
- = mkExpandedTc o <$> -- necessary for breakpoints
- do setInGeneratedCode o $
- tcExpr e res_ty
+ = setInGeneratedCode o $
+ -- e is the expanded expression of o, so we need to set the error ctxt to generated
+ -- see Note [Error Context Stack] in `GHC.Tc.Type.LclEnv`
+ mkExpandedTc o <$> -- necessary for hpc ticks
+ tcExpr e res_ty
-- For record selection, same as HsVar case
tcXExpr xe res_ty = tcApp (XExpr xe) res_ty
@@ -1441,7 +1443,7 @@ expandRecordUpd record_expr possible_parents rbnds res_ty
-- STEP 2 (b): expand to HsCase, as per note [Record Updates]
; let ds_expr :: HsExpr GhcRn
- ds_expr = HsLet noExtField let_binds (L gen case_expr)
+ ds_expr = HsLet noExtField let_binds (wrapGenSpan case_expr)
case_expr :: HsExpr GhcRn
case_expr = HsCase RecUpd record_expr
@@ -1456,11 +1458,10 @@ expandRecordUpd record_expr possible_parents rbnds res_ty
upd_ids_lhs = [ (NonRecursive, [genSimpleFunBind (idName id) [] rhs])
| (_, (id, rhs)) <- upd_ids ]
mk_idSig :: (Name, (Id, LHsExpr GhcRn)) -> LSig GhcRn
- mk_idSig (_, (id, _)) = L gen $ XSig $ IdSig id
+ mk_idSig (_, (id, _)) = wrapGenSpan (XSig $ IdSig id)
-- We let-bind variables using 'IdSig' in order to accept
-- record updates involving higher-rank types.
-- See Wrinkle [Using IdSig] in Note [Record Updates].
- gen = noAnnSrcSpan generatedSrcSpan
; traceTc "expandRecordUpd" $
vcat [ text "relevant_con:" <+> ppr relevant_con
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -152,6 +152,7 @@ takes apart either an HsApp, or an infix OpApp, returning
innermost un-expanded head as the "error head".
* A list of HsExprArg, the arguments
+* We do not look through expanded expressions (except PopErrCtxt.)
-}
data TcPass = TcpRn -- Arguments decomposed
@@ -161,14 +162,14 @@ data TcPass = TcpRn -- Arguments decomposed
data HsExprArg (p :: TcPass) where -- See Note [HsExprArg]
-- Data constructor EValArg represents a value argument
- EValArg :: { ea_ctxt :: SrcSpan
+ EValArg :: { ea_loc_span :: SrcSpan
, ea_arg_ty :: !(XEVAType p)
, ea_arg :: LHsExpr (GhcPass (XPass p)) }
-> HsExprArg p
-- Data constructor EValArgQL represents an argument that has been
-- partly-type-checked by Quick Look; see Note [EValArgQL]
- EValArgQL :: { eaql_ctxt :: SrcSpan
+ EValArgQL :: { eaql_loc_span :: SrcSpan
, eaql_arg_ty :: Scaled TcSigmaType -- Argument type expected by function
, eaql_larg :: LHsExpr GhcRn -- Original application, for
-- location and error msgs
@@ -182,7 +183,7 @@ data HsExprArg (p :: TcPass) where -- See Note [HsExprArg]
, eaql_res_rho :: TcRhoType } -- Result type of the application
-> HsExprArg 'TcpInst -- Only exists in TcpInst phase
- ETypeArg :: { ea_ctxt :: SrcSpan
+ ETypeArg :: { ea_loc_span :: SrcSpan
, ea_hs_ty :: LHsWcType GhcRn -- The type arg
, ea_ty_arg :: !(XETAType p) } -- Kind-checked type arg
-> HsExprArg p
@@ -215,12 +216,12 @@ type family XPass (p :: TcPass) where
XPass 'TcpTc = 'Typechecked
mkEValArg :: SrcSpan -> LHsExpr GhcRn -> HsExprArg 'TcpRn
-mkEValArg ctxt e = EValArg { ea_arg = e, ea_ctxt = ctxt
+mkEValArg src_loc e = EValArg { ea_arg = e, ea_loc_span = src_loc
, ea_arg_ty = noExtField }
mkETypeArg :: SrcSpan -> LHsWcType GhcRn -> HsExprArg 'TcpRn
-mkETypeArg ctxt hs_ty =
- ETypeArg { ea_ctxt = ctxt
+mkETypeArg src_loc hs_ty =
+ ETypeArg { ea_loc_span = src_loc
, ea_hs_ty = hs_ty
, ea_ty_arg = noExtField }
@@ -291,9 +292,9 @@ rebuildHsApps :: (HsExpr GhcTc, SrcSpan)
rebuildHsApps (fun, _) [] = fun
rebuildHsApps (fun, sloc) (arg : args)
= case arg of
- EValArg { ea_arg = arg, ea_ctxt = sloc' }
+ EValArg { ea_arg = arg, ea_loc_span = sloc' }
-> rebuildHsApps (HsApp noExtField lfun arg, sloc') args
- ETypeArg { ea_hs_ty = hs_ty, ea_ty_arg = ty, ea_ctxt = sloc' }
+ ETypeArg { ea_hs_ty = hs_ty, ea_ty_arg = ty, ea_loc_span = sloc' }
-> rebuildHsApps (HsAppType ty lfun hs_ty, sloc') args
EPrag sloc' p
-> rebuildHsApps (HsPragE noExtField p lfun, sloc') args
@@ -330,7 +331,7 @@ instance OutputableBndrId (XPass p) => Outputable (HsExprArg p) where
ppr (EPrag _ p) = text "EPrag" <+> ppr p
ppr (ETypeArg { ea_hs_ty = hs_ty }) = char '@' <> ppr hs_ty
ppr (EWrap wrap) = ppr wrap
- ppr (EValArg { ea_arg = arg, ea_ctxt = sloc })
+ ppr (EValArg { ea_arg = arg, ea_loc_span = sloc })
= text "EValArg" <> braces (ppr sloc) <+> ppr arg
ppr (EValArgQL { eaql_tc_fun = fun, eaql_args = args, eaql_res_rho = ty})
= hang (text "EValArgQL" <+> ppr fun)
=====================================
compiler/GHC/Tc/Types/LclEnv.hs
=====================================
@@ -91,29 +91,54 @@ data TcLclEnv -- Changes as we move inside an expression
tcl_errs :: TcRef (Messages TcRnMessage) -- Place to accumulate diagnostics
}
+{-
+Note [Error Context Stack]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+This data structure keeps track of two things:
+1. Are we type checking a compiler generated/non-user written code.
+2. The trail of the error messages that have been added in route to the current expression
+
+* When the `ErrCtxtStack` is a `UserCodeCtxt`,
+ - the current expression being typechecked is user written
+* When the `ErrorCtxtStack` is a `GeneratedCodeCtxt`
+ - the current expression being typechecked is compiler generated;
+ - the original, possibly user written, source code thing is stored in `src_code_origin` field.
+ - the `src_code_origin` is what will be blamed in the error message
+
+-}
+
+-- See Note [Error Context Stack]
data ErrCtxtStack
- = UserCodeCtxt {err_ctxt :: [ErrCtxt]}
- | GeneratedCodeCtxt { src_code_origin :: SrcCodeOrigin
- , err_ctxt :: [ErrCtxt] }
+ = UserCodeCtxt { lcl_err_ctxt :: [ErrCtxt] } -- ^ Trail of error messages
+ | GeneratedCodeCtxt { src_code_origin :: SrcCodeOrigin -- ^ Original, user written code
+ , lcl_err_ctxt :: [ErrCtxt] } -- ^ Trail of error messages
+-- | Are we in a generated context?
isGeneratedCodeCtxt :: ErrCtxtStack -> Bool
isGeneratedCodeCtxt UserCodeCtxt{} = False
isGeneratedCodeCtxt _ = True
+-- | Get the original source code
get_src_code_origin :: ErrCtxtStack -> Maybe SrcCodeOrigin
get_src_code_origin (UserCodeCtxt{}) = Nothing
+ -- we are in user code, so blame the expression in hand
get_src_code_origin es = Just $ src_code_origin es
+ -- we are in generated code, so extract the original expression
+-- | Modify the error context stack
+-- N.B. If we are in a generated context, any updates to the context stack are ignored.
+-- We want to blame the errors that appear in a generated expression
+-- to the original, user written code
modify_err_ctxt_stack :: ([ErrCtxt] -> [ErrCtxt]) -> ErrCtxtStack -> ErrCtxtStack
modify_err_ctxt_stack f (UserCodeCtxt e) = UserCodeCtxt (f e)
-modify_err_ctxt_stack _ c = c -- any updates on the err context in generated context should be ignored
+modify_err_ctxt_stack _ c = c -- any updates on the err context in a generated context should be ignored
data TcLclCtxt
= TcLclCtxt {
tcl_loc :: RealSrcSpan, -- Source span
- tcl_ctxt :: ErrCtxtStack,
+ tcl_ctxt :: ErrCtxtStack, -- See Note [Error Context Stack]
tcl_tclvl :: TcLevel,
tcl_bndrs :: TcBinderStack, -- Used for reporting relevant bindings,
-- and for tidying type
@@ -178,7 +203,7 @@ getLclEnvLoc :: TcLclEnv -> RealSrcSpan
getLclEnvLoc = tcl_loc . tcl_lcl_ctxt
getLclEnvErrCtxt :: TcLclEnv -> [ErrCtxt]
-getLclEnvErrCtxt = err_ctxt . tcl_ctxt . tcl_lcl_ctxt
+getLclEnvErrCtxt = lcl_err_ctxt . tcl_ctxt . tcl_lcl_ctxt
setLclEnvErrCtxt :: [ErrCtxt] -> TcLclEnv -> TcLclEnv
setLclEnvErrCtxt ctxt = modifyLclCtxt (\env -> env { tcl_ctxt = modify_err_ctxt_stack (\ _ -> ctxt) (tcl_ctxt env) })
@@ -193,7 +218,7 @@ setLclEnvSrcCodeOrigin :: SrcCodeOrigin -> TcLclEnv -> TcLclEnv
setLclEnvSrcCodeOrigin o = modifyLclCtxt (setLclCtxtSrcCodeOrigin o)
setLclCtxtSrcCodeOrigin :: SrcCodeOrigin -> TcLclCtxt -> TcLclCtxt
-setLclCtxtSrcCodeOrigin o ctxt = ctxt { tcl_ctxt = GeneratedCodeCtxt o (err_ctxt $ tcl_ctxt ctxt) }
+setLclCtxtSrcCodeOrigin o ctxt = ctxt { tcl_ctxt = GeneratedCodeCtxt o (lcl_err_ctxt $ tcl_ctxt ctxt) }
lclCtxtInGeneratedCode :: TcLclCtxt -> Bool
lclCtxtInGeneratedCode = isGeneratedCodeCtxt . tcl_ctxt
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -974,9 +974,9 @@ inGeneratedCode = lclEnvInGeneratedCode <$> getLclEnv
setSrcSpan :: SrcSpan -> TcRn a -> TcRn a
-- See Note [Error contexts in generated code]
--- for the tcl_in_gen_code manipulation
setSrcSpan (RealSrcSpan loc _) thing_inside
- = updLclCtxt (\env -> env { tcl_loc = loc, tcl_ctxt = UserCodeCtxt (err_ctxt $ tcl_ctxt env)})
+ = updLclCtxt (\env -> env { tcl_loc = loc
+ , tcl_ctxt = UserCodeCtxt (lcl_err_ctxt $ tcl_ctxt env)})
thing_inside
setSrcSpan (UnhelpfulSpan _) thing_inside
@@ -988,6 +988,7 @@ getSrcCodeOrigin = getLclEnvSrcCodeOrigin <$> getLclEnv
-- | Mark the inner computation as being done inside generated code.
--
-- See Note [Error contexts in generated code]
+-- See Note [Error Context Stack]
setInGeneratedCode :: SrcCodeOrigin -> TcRn a -> TcRn a
setInGeneratedCode sco thing_inside =
updLclCtxt (setLclCtxtSrcCodeOrigin sco) thing_inside
@@ -1210,17 +1211,17 @@ problem.
Note [Error contexts in generated code]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-* setSrcSpan sets tcl_in_gen_code to True if the SrcSpan is GeneratedSrcSpan,
- and back to False when we get a useful SrcSpan
+* If the `SrcSpan` is a `RealSrcSpan`, `setSrcSpan` updates the `tcl_loc`,
+ and makes the `ErrCtxStack` a `UserCodeCtxt`
+* it is a no-op otherwise
-* When tcl_in_gen_code is True, addErrCtxt becomes a no-op.
+So, it's better to do a `setSrcSpan` /before/ `addErrCtxt`.
-So typically it's better to do setSrcSpan /before/ addErrCtxt.
-
-See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr for
-more discussion of this fancy footwork, as well as
-Note [Generated code and pattern-match checking] in GHC.Types.Basic for the
-relation with pattern-match checks.
+- See Note [Rebindable syntax and XXExprGhcRn] in `GHC.Hs.Expr` for
+more discussion of this fancy footwork
+- See Note [Generated code and pattern-match checking] in `GHC.Types.Basic` for the
+relation with pattern-match checks
+- See Note [Error Context Stack] in `GHC.Tc.Types.LclEnv` for info about `ErrCtxtStack`
-}
getErrCtxt :: TcM [ErrCtxt]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35d5a38dc11ddbc6e4482d595de187…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35d5a38dc11ddbc6e4482d595de187…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/andreask/linker_fix] rts: LoadArchive/LoadObj - refactor object verification.
by Andreas Klebinger (@AndreasK) 11 Aug '25
by Andreas Klebinger (@AndreasK) 11 Aug '25
11 Aug '25
Andreas Klebinger pushed to branch wip/andreask/linker_fix at Glasgow Haskell Compiler / GHC
Commits:
4dc3d7bf by Andreas Klebinger at 2025-08-11T18:18:34+02:00
rts: LoadArchive/LoadObj - refactor object verification.
Fixes #26231.
We now consistently call `verifyAndInitOc` to check for valid object code.
Allowing us to replace the somewhat adhoc magic number checking in
loadArchive with the platform specific verification logic.
On windows this adds loadArchive support for
AArch64/32bit COFF bigobj files.
- - - - -
6 changed files:
- rts/Linker.c
- rts/LinkerInternals.h
- rts/linker/LoadArchive.c
- rts/linker/MachO.c
- rts/linker/MachO.h
- rts/linker/PEi386.c
Changes:
=====================================
rts/Linker.c
=====================================
@@ -1415,7 +1415,7 @@ preloadObjectFile (pathchar *path)
// We calculate the correct alignment from the header before
// reading the file, and then we misalign image on purpose so
// that the actual sections end up aligned again.
- misalignment = machoGetMisalignment(f);
+ machoGetMisalignment(f, &misalignment);
image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
image += misalignment;
@@ -1441,14 +1441,11 @@ preloadObjectFile (pathchar *path)
/* FIXME (AP): =mapped= parameter unconditionally set to true */
oc = mkOc(STATIC_OBJECT, path, image, fileSize, true, NULL, misalignment);
-#if defined(OBJFORMAT_MACHO)
- if (ocVerifyImage_MachO( oc ))
- ocInit_MachO( oc );
-#endif
-#if defined(OBJFORMAT_ELF)
- if(ocVerifyImage_ELF( oc ))
- ocInit_ELF( oc );
-#endif
+ if (!verifyAndInitOc(oc)) {
+ freeObjectCode(oc);
+ debugBelch("loadObj: Failed to verify oc.\n");
+ return NULL;
+ };
return oc;
}
@@ -1505,27 +1502,44 @@ HsInt loadObj (pathchar *path)
return r;
}
+// Call the relevant VeriffyImage_* and ocInit_* functions.
+// Return 1 on success.
+HsInt verifyAndInitOc (ObjectCode* oc)
+{
+ int r;
+
+ IF_DEBUG(linker, ocDebugBelch(oc, "start\n"));
+
+ /* verify the in-memory image */
+#if defined(OBJFORMAT_ELF)
+ r = ocVerifyImage_ELF ( oc );
+ if(r) {
+ ocInit_ELF( oc );
+ }
+#elif defined(OBJFORMAT_PEi386)
+ r = ocVerifyImage_PEi386 ( oc );
+#elif defined(OBJFORMAT_MACHO)
+ r = ocVerifyImage_MachO ( oc );
+ if(r) {
+ ocInit_MachO( oc );
+ }
+#else
+ barf("loadObj: no verify method");
+#endif
+ if (!r) {
+ IF_DEBUG(linker, ocDebugBelch(oc, "ocVerifyImage_* failed\n"));
+ return r;
+ }
+ return 1;
+}
+
+// Precondition: oc already verified.
HsInt loadOc (ObjectCode* oc)
{
int r;
IF_DEBUG(linker, ocDebugBelch(oc, "start\n"));
- /* verify the in-memory image */
-# if defined(OBJFORMAT_ELF)
- r = ocVerifyImage_ELF ( oc );
-# elif defined(OBJFORMAT_PEi386)
- r = ocVerifyImage_PEi386 ( oc );
-# elif defined(OBJFORMAT_MACHO)
- r = ocVerifyImage_MachO ( oc );
-# else
- barf("loadObj: no verify method");
-# endif
- if (!r) {
- IF_DEBUG(linker, ocDebugBelch(oc, "ocVerifyImage_* failed\n"));
- return r;
- }
-
/* Note [loadOc orderings]
~~~~~~~~~~~~~~~~~~~~~~~
The order of `ocAllocateExtras` and `ocGetNames` matters. For MachO
=====================================
rts/LinkerInternals.h
=====================================
@@ -485,12 +485,18 @@ HsInt loadArchive_ (pathchar *path);
HsInt isAlreadyLoaded( pathchar *path );
OStatus getObjectLoadStatus_ (pathchar *path);
ObjectCode *lookupObjectByPath(pathchar *path);
+
+/* Verify an objects is an a format that can be loaded and initialize the oc struct if required. */
+HsInt verifyAndInitOc( ObjectCode *oc );
+
+//Expects the oc to be verified already.
HsInt loadOc( ObjectCode* oc );
ObjectCode* mkOc( ObjectType type, pathchar *path, char *image, int imageSize,
bool mapped, pathchar *archiveMemberName,
int misalignment
);
+
void initSegment(Segment *s, void *start, size_t size, SegmentProt prot, int n_sections);
void freeSegments(ObjectCode *oc);
=====================================
rts/linker/LoadArchive.c
=====================================
@@ -110,51 +110,6 @@ static bool loadFatArchive(char input[static 20], FILE* f, pathchar* path)
}
#endif
-enum ObjectFileFormat {
- NotObject,
- COFFAmd64,
- COFFI386,
- COFFAArch64,
- ELF,
- MachO32,
- MachO64,
-};
-
-static enum ObjectFileFormat identifyObjectFile_(char* buf, size_t sz)
-{
- if (sz > 2 && ((uint16_t*)buf)[0] == 0x8664) {
- return COFFAmd64;
- }
- if (sz > 2 && ((uint16_t*)buf)[0] == 0x014c) {
- return COFFI386;
- }
- if (sz > 2 && ((uint16_t*)buf)[0] == 0xaa64) {
- return COFFAArch64;
- }
- if (sz > 4 && memcmp(buf, "\x7f" "ELF", 4) == 0) {
- return ELF;
- }
- if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedface) {
- return MachO32;
- }
- if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedfacf) {
- return MachO64;
- }
- // BigObj COFF files ...
- if (sz > 8 && ((uint64_t*)buf)[0] == 0x86640002ffff0000) {
- return COFFAmd64;
- }
- return NotObject;
-}
-
-static enum ObjectFileFormat identifyObjectFile(FILE *f)
-{
- char buf[32];
- ssize_t sz = fread(buf, 1, 32, f);
- CHECK(fseek(f, -sz, SEEK_CUR) == 0);
- return identifyObjectFile_(buf, sz);
-}
-
static bool readThinArchiveMember(int n, int memberSize, pathchar* path,
char* fileName, char* image)
{
@@ -547,9 +502,11 @@ HsInt loadArchive_ (pathchar *path)
}
DEBUG_LOG("Found member file `%s'\n", fileName);
-
bool is_symbol_table = strcmp("", fileName) == 0;
- enum ObjectFileFormat object_fmt = is_symbol_table ? NotObject : identifyObjectFile(f);
+
+/////////////////////////////////////////////////
+// We found the member file. Load it into memory.
+/////////////////////////////////////////////////
#if defined(OBJFORMAT_PEi386)
/*
@@ -569,17 +526,22 @@ HsInt loadArchive_ (pathchar *path)
#endif // windows
DEBUG_LOG("\tthisFileNameSize = %d\n", (int)thisFileNameSize);
- DEBUG_LOG("\tisObject = %d\n", object_fmt);
+ // DEBUG_LOG("\tisObject = %d\n", object_fmt);
- if ((!is_symbol_table && isThin) || object_fmt != NotObject) {
- DEBUG_LOG("Member is an object file...loading...\n");
+ //if ((!is_symbol_table && isThin) || object_fmt != NotObject)
+ if (!is_symbol_table && !isImportLib)
+ {
+ DEBUG_LOG("Member might be an object file...loading...\n");
#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
if (RTS_LINKER_USE_MMAP)
image = mmapAnonForLinker(memberSize);
else {
/* See loadObj() */
- misalignment = machoGetMisalignment(f);
+ if(!machoGetMisalignment(f, &misalignment))
+ DEBUG_LOG("Failed to load member as mach-o file. Skipping.\n");
+ continue;
+ }
image = stgMallocBytes(memberSize + misalignment,
"loadArchive(image)");
image += misalignment;
@@ -610,19 +572,23 @@ HsInt loadArchive_ (pathchar *path)
pathprintf(archiveMemberName, size+1, WSTR("%" PATH_FMT "(#%d:%.*s)"),
path, memberIdx, (int)thisFileNameSize, fileName);
+///////////////////////////////////////////////////////////////
+// Verfiy the object file is valid, and load it if appropriate.
+///////////////////////////////////////////////////////////////
+
+ // Prepare headers, doesn't load any data yet.
ObjectCode *oc = mkOc(STATIC_OBJECT, path, image, memberSize, false, archiveMemberName,
misalignment);
-#if defined(OBJFORMAT_MACHO)
- ASSERT(object_fmt == MachO32 || object_fmt == MachO64);
- ocInit_MachO( oc );
-#endif
-#if defined(OBJFORMAT_ELF)
- ASSERT(object_fmt == ELF);
- ocInit_ELF( oc );
-#endif
-
stgFree(archiveMemberName);
+ if(!verifyAndInitOc( oc ))
+ {
+ freeObjectCode( oc );
+ IF_DEBUG(linker, ocDebugBelch(oc, "Faild to verify ... skipping."));
+ continue;
+ };
+
+
if (0 == loadOc(oc)) {
stgFree(fileName);
fclose(f);
=====================================
rts/linker/MachO.c
=====================================
@@ -1725,31 +1725,41 @@ ocRunFini_MachO ( ObjectCode *oc )
/*
* Figure out by how much to shift the entire Mach-O file in memory
* when loading so that its single segment ends up 16-byte-aligned
+ *
+ * Returns 1 and sets misalignment_out to the detected misalignment if
+ * we successfully parsed the file.
+ *
+ * If we can't parse the file we set misalignment_out to 0 and return 0
*/
int
-machoGetMisalignment( FILE * f )
+machoGetMisalignment( FILE * f, int* misalignment_out )
{
MachOHeader header;
int misalignment;
+ *misalignment_out = 0;
{
size_t n = fread(&header, sizeof(header), 1, f);
if (n != 1) {
- barf("machoGetMisalignment: can't read the Mach-O header");
+ debugBelch("machoGetMisalignment: can't read the Mach-O header");
+ return 0;
}
}
fseek(f, -sizeof(header), SEEK_CUR);
if(header.magic != MH_MAGIC_64) {
- barf("Bad magic. Expected: %08x, got: %08x.",
+ debugBelch("Bad magic. Expected: %08x, got: %08x.",
MH_MAGIC_64, header.magic);
+ return 0;
}
misalignment = (header.sizeofcmds + sizeof(header))
& 0xF;
IF_DEBUG(linker, debugBelch("mach-o misalignment %d\n", misalignment));
- return misalignment ? (16 - misalignment) : 0;
+ misalignment ? (16 - misalignment) : 0;
+ *misalignment_out = misalignment
+ return 1;
}
#endif /* darwin_HOST_OS || ios_HOST_OS */
=====================================
rts/linker/MachO.h
=====================================
@@ -13,7 +13,7 @@ int ocGetNames_MachO ( ObjectCode* oc );
int ocResolve_MachO ( ObjectCode* oc );
int ocRunInit_MachO ( ObjectCode* oc );
int ocRunFini_MachO ( ObjectCode* oc );
-int machoGetMisalignment ( FILE * );
+int machoGetMisalignment ( FILE *, int* );
int ocAllocateExtras_MachO ( ObjectCode* oc );
SectionKind getSectionKind_MachO ( MachOSection *macho );
=====================================
rts/linker/PEi386.c
=====================================
@@ -775,6 +775,10 @@ COFF_OBJ_TYPE getObjectType ( char* image, pathchar* fileName )
*************/
COFF_HEADER_INFO* getHeaderInfo ( ObjectCode* oc )
{
+ if((size_t) oc->fileSize < sizeof(IMAGE_FILE_HEADER)) {
+ errorBelch ("Supposed COFF file smaller than minimum header size.\n");
+ return NULL;
+ }
COFF_OBJ_TYPE coff_type = getObjectType (oc->image, OC_INFORMATIVE_FILENAME(oc));
COFF_HEADER_INFO* info
@@ -808,6 +812,11 @@ COFF_HEADER_INFO* getHeaderInfo ( ObjectCode* oc )
stgFree (info);
info = NULL;
errorBelch ("Unknown COFF %d type in getHeaderInfo.", coff_type);
+ if(oc->archiveMemberName) {
+ errorBelch ("Archive %" PATH_FMT ".\n", oc->archiveMemberName);
+ }
+ errorBelch ("In %" PATH_FMT ".\n", oc->fileName);
+
}
break;
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4dc3d7bfa10de3579d30f818792377c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4dc3d7bfa10de3579d30f818792377c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/T23109] 7 commits: Take more care in zonkEqTypes on AppTy/AppTy
by Ben Gamari (@bgamari) 11 Aug '25
by Ben Gamari (@bgamari) 11 Aug '25
11 Aug '25
Ben Gamari pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC
Commits:
18036d52 by Simon Peyton Jones at 2025-08-11T11:31:20-04:00
Take more care in zonkEqTypes on AppTy/AppTy
This patch fixes #26256.
See Note [zonkEqTypes and the PKTI] in GHC.Tc.Solver.Equality
- - - - -
c8d76a29 by Zubin Duggal at 2025-08-11T11:32:02-04:00
ci: upgrade bootstrap compiler on windows to 9.10.1
- - - - -
518a7d3e by Simon Peyton Jones at 2025-08-11T12:18:01-04:00
Make injecting implicit bindings into its own pass
Previously we were injecting "impliicit bindings" (data constructor
worker and wrappers etc)
- both at the end of CoreTidy,
- and at the start of CorePrep
This is unpleasant and confusing. This patch puts it it its own pass,
addImplicitBinds, which runs between the two.
The function `GHC.CoreToStg.AddImplicitBinds.addImplicitBinds` now takes /all/
TyCons, not just the ones for algebraic data types. That change ripples
through to
- corePrepPgm
- doCodeGen
- byteCodeGen
All take [TyCon] which includes all TyCons
- - - - -
b68832ac by Simon Peyton Jones at 2025-08-11T12:18:01-04:00
Implement unary classes
The big change is described exhaustively in
Note [Unary class magic] in GHC.Core.TyCon
Other changes
* We never unbox class dictionaries in worker/wrapper. This has been true for some
time now, but the logic is now centralised in functions in
GHC.Core.Opt.WorkWrap.Utils, namely `canUnboxTyCon`, and `canUnboxArg`
See Note [Do not unbox class dictionaries] in GHC.Core.Opt.WorkWrap.Utils.
* Refactored the `notWorthFloating` logic in GHc.Core.Opt.SetLevels.
I can't remember if I actually changed any behaviour here, but if so it's
only in a corner cases.
* Fixed a bug in `GHC.Core.TyCon.isEnumerationTyCon`, which was wrongly returning
True for (##).
* Remove redundant Role argument to `liftCoSubstWithEx`. It was always
Representational.
* I refactored evidence generation in the constraint solver:
* Made GHC.Tc.Types.Evidence contain better abstactions for evidence
generation.
* I deleted the file `GHC.Tc.Types.EvTerm` and merged its (small) contents
elsewhere. It wasn't paying its way.
* Made evidence for implicit parameters go via a proper abstraction.
* Fix inlineBoringOk; see (IB6) in Note [inlineBoringOk]
This fixes a slowdown in `countdownEffectfulDynLocal`
in the `effectful` library.
Smaller things
* Rename `isDataTyCon` to `isBoxedDataTyCon`.
* GHC.Core.Corecion.liftCoSubstWithEx was only called with Representational role,
so I baked that into the function and removed the argument.
* Get rid of `GHC.Core.TyCon.tyConSingleAlgDataCon_maybe` in favour of calling
`not isNewTyCon` at the call sites; more explicit.
* Refatored `GHC.Core.TyCon.isInjectiveTyCon`; but I don't think I changed its
behaviour
* Moved `decomposeIPPred` to GHC.Core.Predicate
Compile time performance changes:
geo. mean +0.1%
minimum -6.8%
maximum +14.4%
The +14% one is in T21839c, where it seems that a bit more inlining
is taking place. That seems acceptable; and the average change is small
Metric Decrease:
LargeRecord
T12227
T16577
T21839r
T5642
Metric Increase:
T15164
T21839c
T3294
T5321FD
T5321Fun
WWRec
- - - - -
285ca804 by Simon Peyton Jones at 2025-08-11T12:18:01-04:00
Slight improvement to pre/postInlineUnconditionally
Avoids an extra simplifier iteration
- - - - -
25dfe2d0 by Simon Peyton Jones at 2025-08-11T12:18:01-04:00
Fix a long-standing assertion error in normSplitTyConApp_maybe
- - - - -
9e2f2d82 by Simon Peyton Jones at 2025-08-11T12:18:01-04:00
Add comment to coercion optimiser
- - - - -
101 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/ByteCode/InfoTable.hs
- compiler/GHC/Core/Class.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Predicate.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/Unfold/Make.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- + compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- − compiler/GHC/Tc/Types/EvTerm.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/TyThing.hs
- compiler/ghc.cabal.in
- testsuite/tests/core-to-stg/T24124.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- testsuite/tests/dmdanal/should_compile/T16029.stdout
- testsuite/tests/dmdanal/sigs/T21119.stderr
- testsuite/tests/dmdanal/sigs/T21888.stderr
- testsuite/tests/ghci.debugger/scripts/break011.stdout
- testsuite/tests/ghci.debugger/scripts/break024.stdout
- testsuite/tests/indexed-types/should_compile/T2238.hs
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/numeric/should_compile/T23907.stderr
- + testsuite/tests/partial-sigs/should_compile/T26256.hs
- + testsuite/tests/partial-sigs/should_compile/T26256.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/simplCore/should_compile/DataToTagFamilyScrut.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
- testsuite/tests/simplCore/should_compile/T17366.stderr
- testsuite/tests/simplCore/should_compile/T17966.stderr
- testsuite/tests/simplCore/should_compile/T22309.stderr
- testsuite/tests/simplCore/should_compile/T22375DataFamily.stderr
- testsuite/tests/simplCore/should_compile/T23307.stderr
- testsuite/tests/simplCore/should_compile/T23307a.stderr
- testsuite/tests/simplCore/should_compile/T25389.stderr
- testsuite/tests/simplCore/should_compile/T25713.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplStg/should_compile/T15226b.stderr
- testsuite/tests/tcplugins/CtIdPlugin.hs
- testsuite/tests/typecheck/should_compile/Makefile
- testsuite/tests/typecheck/should_compile/T12763.stderr
- testsuite/tests/typecheck/should_compile/T14774.stdout
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- + testsuite/tests/typecheck/should_compile/T26256a.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/unboxedsums/unpack_sums_7.stdout
- testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs
- testsuite/tests/wasm/should_run/control-flow/RunWasm.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bba4f666c00bdcc13e56a038d0a88d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bba4f666c00bdcc13e56a038d0a88d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][master] ci: upgrade bootstrap compiler on windows to 9.10.1
by Marge Bot (@marge-bot) 11 Aug '25
by Marge Bot (@marge-bot) 11 Aug '25
11 Aug '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c8d76a29 by Zubin Duggal at 2025-08-11T11:32:02-04:00
ci: upgrade bootstrap compiler on windows to 9.10.1
- - - - -
2 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -478,7 +478,7 @@ opsysVariables _ (Windows {}) = mconcat
, "LANG" =: "en_US.UTF-8"
, "CABAL_INSTALL_VERSION" =: "3.10.2.0"
, "HADRIAN_ARGS" =: "--docs=no-sphinx-pdfs"
- , "GHC_VERSION" =: "9.6.4"
+ , "GHC_VERSION" =: "9.10.1"
]
opsysVariables _ _ = mempty
=====================================
.gitlab/jobs.yaml
=====================================
@@ -3698,7 +3698,7 @@
"BUILD_FLAVOUR": "validate",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"LANG": "en_US.UTF-8",
@@ -3761,7 +3761,7 @@
"BUILD_FLAVOUR": "validate",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"LANG": "en_US.UTF-8",
@@ -5579,7 +5579,7 @@
"BUILD_FLAVOUR": "release",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"IGNORE_PERF_FAILURES": "all",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
@@ -5643,7 +5643,7 @@
"BUILD_FLAVOUR": "release",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"IGNORE_PERF_FAILURES": "all",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
@@ -7982,7 +7982,7 @@
"BUILD_FLAVOUR": "validate",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"LANG": "en_US.UTF-8",
@@ -8044,7 +8044,7 @@
"BUILD_FLAVOUR": "validate",
"CABAL_INSTALL_VERSION": "3.10.2.0",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "GHC_VERSION": "9.6.4",
+ "GHC_VERSION": "9.10.1",
"HADRIAN_ARGS": "--docs=no-sphinx-pdfs",
"INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
"LANG": "en_US.UTF-8",
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8d76a2994b8620c54adc2069f47281…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8d76a2994b8620c54adc2069f47281…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][master] Take more care in zonkEqTypes on AppTy/AppTy
by Marge Bot (@marge-bot) 11 Aug '25
by Marge Bot (@marge-bot) 11 Aug '25
11 Aug '25
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
18036d52 by Simon Peyton Jones at 2025-08-11T11:31:20-04:00
Take more care in zonkEqTypes on AppTy/AppTy
This patch fixes #26256.
See Note [zonkEqTypes and the PKTI] in GHC.Tc.Solver.Equality
- - - - -
6 changed files:
- compiler/GHC/Tc/Solver/Equality.hs
- + testsuite/tests/partial-sigs/should_compile/T26256.hs
- + testsuite/tests/partial-sigs/should_compile/T26256.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- + testsuite/tests/typecheck/should_compile/T26256a.hs
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -197,12 +197,8 @@ zonkEqTypes ev eq_rel ty1 ty2
then tycon tc1 tys1 tys2
else bale_out ty1 ty2
- go ty1 ty2
- | Just (ty1a, ty1b) <- tcSplitAppTyNoView_maybe ty1
- , Just (ty2a, ty2b) <- tcSplitAppTyNoView_maybe ty2
- = do { res_a <- go ty1a ty2a
- ; res_b <- go ty1b ty2b
- ; return $ combine_rev mkAppTy res_b res_a }
+ -- If you are temppted to add a case for AppTy/AppTy, be careful
+ -- See Note [zonkEqTypes and the PKTI]
go ty1@(LitTy lit1) (LitTy lit2)
| lit1 == lit2
@@ -278,6 +274,32 @@ zonkEqTypes ev eq_rel ty1 ty2
combine_rev f (Right tys) (Right ty) = Right (f ty tys)
+{- Note [zonkEqTypes and the PKTI]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Because `zonkEqTypes` does /partial/ zonking, we need to be very careful
+to maintain the Purely Kinded Type Invariant: see GHC.Tc.Gen/HsType
+HsNote [The Purely Kinded Type Invariant (PKTI)].
+
+In #26256 we try to solve this equality constraint:
+ Int :-> Maybe Char ~# k0 Int (m0 Char)
+where m0 and k0 are unification variables, and
+ m0 :: Type -> Type
+It happens that m0 was already unified
+ m0 := (w0 :: kappa)
+where kappa is another unification variable that is also already unified:
+ kappa := Type->Type.
+So the original type satisifed the PKTI, but a partially-zonked form
+ k0 Int (w0 Char)
+does not!! (This a bit reminiscent of Note [mkAppTyM].)
+
+The solution I have adopted is simply to make `zonkEqTypes` bale out on `AppTy`.
+After all, it's only supposed to be a quick hack to see if two types are already
+equal; if we bale out we'll just get into the "proper" canonicaliser.
+
+The only tricky thing about this approach is that it relies on /omitting/
+code -- for the AppTy/AppTy case! Hence this Note
+-}
+
{- *********************************************************************
* *
* canonicaliseEquality
=====================================
testsuite/tests/partial-sigs/should_compile/T26256.hs
=====================================
@@ -0,0 +1,23 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+
+module M (go) where
+
+import Data.Kind
+
+type Apply :: (Type -> Type) -> Type
+data Apply m
+
+type (:->) :: Type -> Type -> Type
+type family (:->) where (:->) = (->)
+
+f :: forall (k :: Type -> Type -> Type) (m :: Type -> Type).
+ k Int (m Char) -> k Bool (Apply m)
+f = f
+
+x :: Int :-> Maybe Char
+x = x
+
+go :: Bool -> _ _
+go = f x
=====================================
testsuite/tests/partial-sigs/should_compile/T26256.stderr
=====================================
@@ -0,0 +1,8 @@
+T26256.hs:22:15: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘Apply :: (* -> *) -> *’
+ • In the type signature: go :: Bool -> _ _
+
+T26256.hs:22:17: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘Maybe :: * -> *’
+ • In the first argument of ‘_’, namely ‘_’
+ In the type signature: go :: Bool -> _ _
=====================================
testsuite/tests/partial-sigs/should_compile/all.T
=====================================
@@ -108,3 +108,4 @@ test('T21667', normal, compile, [''])
test('T22065', normal, compile, [''])
test('T16152', normal, compile, [''])
test('T20076', expect_broken(20076), compile, [''])
+test('T26256', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_compile/T26256a.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T26256 (go) where
+
+import Data.Kind
+
+class Cat k where (<<<) :: k a b -> k x a -> k x b
+instance Cat (->) where (<<<) = (.)
+class Pro k p where pro :: k a b s t -> p a b -> p s t
+data Hiding o a b s t = forall e. Hiding (s -> o e a)
+newtype Apply e a = Apply (e a)
+
+type (:->) :: Type -> Type -> Type
+type family (:->) where
+ (:->) = (->)
+
+go :: (Pro (Hiding Apply) p) => (s :-> e a) -> p a b -> p s t
+go sea = pro (Hiding (Apply <<< sea))
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -940,3 +940,4 @@ test('T26020', normal, compile, [''])
test('T26020a', [extra_files(['T26020a_help.hs'])], multimod_compile, ['T26020a', '-v0'])
test('T25992', normal, compile, [''])
test('T14010', normal, compile, [''])
+test('T26256a', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18036d5205ac648bb245217519fed2f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18036d5205ac648bb245217519fed2f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/T23109] 15 commits: Handle non-fractional CmmFloats in Cmm's CBE (#26229)
by Ben Gamari (@bgamari) 11 Aug '25
by Ben Gamari (@bgamari) 11 Aug '25
11 Aug '25
Ben Gamari pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC
Commits:
03555ed8 by Sylvain Henry at 2025-08-10T22:20:57-04:00
Handle non-fractional CmmFloats in Cmm's CBE (#26229)
Since f8d9d016305be355f518c141f6c6d4826f2de9a2, toRational for Float and
Double converts float's infinity and NaN into Rational's infinity and
NaN (respectively 1%0 and 0%0).
Cmm CommonBlockEliminator hashing function needs to take these values
into account as they can appear as literals now. See added testcase.
- - - - -
6c956af3 by J. Ryan Stinnett at 2025-08-10T22:21:42-04:00
Fix extensions list in `DoAndIfThenElse` docs
- - - - -
6dc420b1 by J. Ryan Stinnett at 2025-08-10T22:21:42-04:00
Document status of `RelaxedPolyRec` extension
This adds a brief extension page explaining the status of the
`RelaxedPolyRec` extension. The behaviour of this mode is already
explained elsewhere, so this page is mainly for completeness so that
various lists of extensions have somewhere to point to for this flag.
Fixes #18630
- - - - -
b73b3f17 by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Make injecting implicit bindings into its own pass
Previously we were injecting "impliicit bindings" (data constructor
worker and wrappers etc)
- both at the end of CoreTidy,
- and at the start of CorePrep
This is unpleasant and confusing. This patch puts it it its own pass,
addImplicitBinds, which runs between the two.
The function `GHC.CoreToStg.AddImplicitBinds.addImplicitBinds` now takes /all/
TyCons, not just the ones for algebraic data types. That change ripples
through to
- corePrepPgm
- doCodeGen
- byteCodeGen
All take [TyCon] which includes all TyCons
- - - - -
43c93a7d by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Implement unary classes
The big change is described exhaustively in
Note [Unary class magic] in GHC.Core.TyCon
Other changes
* We never unbox class dictionaries in worker/wrapper. This has been true for some
time now, but the logic is now centralised in functions in
GHC.Core.Opt.WorkWrap.Utils, namely `canUnboxTyCon`, and `canUnboxArg`
See Note [Do not unbox class dictionaries] in GHC.Core.Opt.WorkWrap.Utils.
* Refactored the `notWorthFloating` logic in GHc.Core.Opt.SetLevels.
I can't remember if I actually changed any behaviour here, but if so it's
only in a corner cases.
* Fixed a bug in `GHC.Core.TyCon.isEnumerationTyCon`, which was wrongly returning
True for (##).
* Remove redundant Role argument to `liftCoSubstWithEx`. It was always
Representational.
* I refactored evidence generation in the constraint solver:
* Made GHC.Tc.Types.Evidence contain better abstactions for evidence
generation.
* I deleted the file `GHC.Tc.Types.EvTerm` and merged its (small) contents
elsewhere. It wasn't paying its way.
* Made evidence for implicit parameters go via a proper abstraction.
* Fix inlineBoringOk; see (IB6) in Note [inlineBoringOk]
This fixes a slowdown in `countdownEffectfulDynLocal`
in the `effectful` library.
Smaller things
* Rename `isDataTyCon` to `isBoxedDataTyCon`.
* GHC.Core.Corecion.liftCoSubstWithEx was only called with Representational role,
so I baked that into the function and removed the argument.
* Get rid of `GHC.Core.TyCon.tyConSingleAlgDataCon_maybe` in favour of calling
`not isNewTyCon` at the call sites; more explicit.
* Refatored `GHC.Core.TyCon.isInjectiveTyCon`; but I don't think I changed its
behaviour
* Moved `decomposeIPPred` to GHC.Core.Predicate
Compile time performance changes:
geo. mean +0.1%
minimum -6.8%
maximum +14.4%
The +14% one is in T21839c, where it seems that a bit more inlining
is taking place. That seems acceptable; and the average change is small
Metric Decrease:
LargeRecord
T12227
T16577
T21839r
T5642
Metric Increase:
T15164
T21839c
T3294
T5321FD
T5321Fun
WWRec
- - - - -
0c9acb5e by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Accept GHCi debugger output change
@alt-romes says this is fine
- - - - -
92f4dc66 by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Small hacky fix to specUnfolding
...just using mkApps instead of mkCoreApps
(This part is likely to change again in a
future commit.)
- - - - -
62ac0bdc by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Slight improvement to pre/postInlineUnconditionally
Avoids an extra simplifier iteration
- - - - -
c8258401 by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Fix a long-standing assertion error in normSplitTyConApp_maybe
- - - - -
b8bc92b3 by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Add comment to coercion optimiser
- - - - -
9c1e4f89 by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Fix mergo bugs
- - - - -
5c30a79a by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Wibble imports
- - - - -
3a7ce66e by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Fix specialiser
..needs documentation
- - - - -
d8a6fccf by Simon Peyton Jones at 2025-08-11T15:21:15+00:00
Wibbles
- - - - -
bba4f666 by Ben Gamari at 2025-08-11T15:21:15+00:00
Move addImplicitBinds
- - - - -
103 changed files:
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/ByteCode/InfoTable.hs
- compiler/GHC/Cmm/CommonBlockElim.hs
- compiler/GHC/Core/Class.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Predicate.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/Unfold/Make.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- + compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- − compiler/GHC/Tc/Types/EvTerm.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/RepType.hs
- compiler/GHC/Types/TyThing.hs
- compiler/ghc.cabal.in
- docs/users_guide/conf.py
- docs/users_guide/expected-undocumented-flags.txt
- docs/users_guide/exts/doandifthenelse.rst
- + docs/users_guide/exts/relaxed_poly_rec.rst
- docs/users_guide/exts/types.rst
- testsuite/tests/core-to-stg/T24124.stderr
- testsuite/tests/deSugar/should_compile/T2431.stderr
- testsuite/tests/dmdanal/should_compile/T16029.stdout
- testsuite/tests/dmdanal/sigs/T21119.stderr
- testsuite/tests/dmdanal/sigs/T21888.stderr
- testsuite/tests/ghci.debugger/scripts/break011.stdout
- testsuite/tests/ghci.debugger/scripts/break024.stdout
- testsuite/tests/indexed-types/should_compile/T2238.hs
- testsuite/tests/numeric/should_compile/T15547.stderr
- testsuite/tests/numeric/should_compile/T23907.stderr
- + testsuite/tests/numeric/should_compile/T26229.hs
- testsuite/tests/numeric/should_compile/all.T
- testsuite/tests/roles/should_compile/Roles14.stderr
- testsuite/tests/roles/should_compile/Roles3.stderr
- testsuite/tests/roles/should_compile/Roles4.stderr
- testsuite/tests/simplCore/should_compile/DataToTagFamilyScrut.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
- testsuite/tests/simplCore/should_compile/T17366.stderr
- testsuite/tests/simplCore/should_compile/T17966.stderr
- testsuite/tests/simplCore/should_compile/T22309.stderr
- testsuite/tests/simplCore/should_compile/T22375DataFamily.stderr
- testsuite/tests/simplCore/should_compile/T23307.stderr
- testsuite/tests/simplCore/should_compile/T23307a.stderr
- testsuite/tests/simplCore/should_compile/T25389.stderr
- testsuite/tests/simplCore/should_compile/T25713.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplStg/should_compile/T15226b.stderr
- testsuite/tests/tcplugins/CtIdPlugin.hs
- testsuite/tests/typecheck/should_compile/Makefile
- testsuite/tests/typecheck/should_compile/T12763.stderr
- testsuite/tests/typecheck/should_compile/T14774.stdout
- testsuite/tests/typecheck/should_compile/T18406b.stderr
- testsuite/tests/typecheck/should_compile/T18529.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/unboxedsums/unpack_sums_7.stdout
- testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs
- testsuite/tests/wasm/should_run/control-flow/RunWasm.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/977ee0da9ef57ff73b7ac229d288a9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/977ee0da9ef57ff73b7ac229d288a9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0