Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 66d1a5d5 by fendor at 2026-07-07T16:57:56-04:00 Add 'backendInfoTableMapValidity' backend predicate Check whether the backend supports the `-finfo-table-map` flag and ignore it otherwise. Improve by-design documentation of `backendCodeOutput`. `Backend` is **abstract by design**. Make this clearer in `backendCodeOutput` which is incorrectly being used as a proxy for `Backend`. Instead, define the desired property predicates in GHC.Driver.Backend In the process, make `backendCodeOutput` total. - - - - - 74f1071d by fendor at 2026-07-07T16:57:56-04:00 Add failing test for `-finfo-table-map` and bytecode backend If you compile a module using the bytecode backend, with -finfo-table-map, then the info table map doesn't get populated for the module. This is because the -finfo-table-map code path is implemented mostly in the StgToCmm phase which isn't run when creating bytecode. Ticket #27039 - - - - - 28d63bca by mangoiv at 2026-07-07T16:59:16-04:00 ci: don't fail nightly if there have been no changes that night Fixes #27127 - - - - - 8bd69b38 by Simon Peyton Jones at 2026-07-07T17:34:36-04:00 Update equality-type documenation in GHC.Builtin.Types.Prim Fix #27466 - - - - - 55184981 by Simon Peyton Jones at 2026-07-07T17:34:37-04:00 Honour -dsuppress-coercions in GHC.Core.TyCo.pprCo Fixes #27467 - - - - - 1a45bfe9 by Facundo Domínguez at 2026-07-07T17:34:40-04:00 Add item to MR checklist asking to squash fixup commits after approval The checklist has an item that reads All commits are either individually buildable or squashed. This item could be checked immediately after sending the merge request though. If reviewers ask for amends later on, and the author amends the merge request, there was no item that would remind the contributors to squash the fixup commits before landing. This commit adds a new item After all approvals and before landing: all fixup commits are squashed with their originating commits. which should be harder to mark as done before approvals have been given. - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main/Compile.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - testsuite/tests/codeGen/should_compile/T25177.stderr - testsuite/tests/deSugar/should_fail/all.T - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/ghci/scripts/bytecodeIPE.hs - + testsuite/tests/ghci/scripts/bytecodeIPE.script - + testsuite/tests/ghci/scripts/bytecodeIPE.stdout - testsuite/tests/numeric/should_compile/T15547.stderr - testsuite/tests/simplCore/should_compile/DataToTagFamilyScrut.stderr - testsuite/tests/simplCore/should_compile/T14978.stdout - testsuite/tests/simplCore/should_compile/T18013.stderr - testsuite/tests/simplCore/should_compile/T24229a.stderr - testsuite/tests/simplCore/should_compile/T24229b.stderr Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1307,7 +1307,8 @@ ghcup-metadata-nightly-push: - git config user.name "GHC GitLab CI" - git remote add gitlab_origin https://oauth2:$PROJECT_PUSH_TOKEN@gitlab.haskell.org/ghc/ghcup-metadata.git - git add . - - git commit -m "Update metadata" + # a metadata nightly run may result in no changes. We reflect that in the commit message. + - git diff --cached --quiet && git commit --allow-empty -m "Updated metadata - no changes" || git commit -m "Update metadata" - git push gitlab_origin HEAD:updates rules: # Only run the update on scheduled nightly pipelines, ie once a day ===================================== .gitlab/merge_request_templates/Default.md ===================================== @@ -27,6 +27,7 @@ https://gitlab.haskell.org/ghc/ghc/-/wikis/Contributing-a-Patch - [ ] If this MR has the potential to break user programs, the ~"user-facing" label was applied to test against head.hackage. - [ ] All commits are either individually buildable or squashed. +- [ ] After all approvals and before landing: all fixup commits are squashed with their originating commits. - [ ] Commit messages describe *what they do*, referring to tickets using `#NNNNN` syntax. - [ ] Source comments describing the change were added. For larger changes [notes][notes] and cross-references from the relevant places were added (as applicable). ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -352,7 +352,10 @@ def main() -> None: with open(args.metadata, 'r') as file: ghcup_metadata = yaml.safe_load(file) if args.version in ghcup_metadata['ghcupDownloads']['GHC']: - raise RuntimeError("Refusing to override existing version in metadata") + # if there are days without a commit, then the nightly metadata + # is up to date by default, no need to fail, no need to upload anything + print("Refusing to override existing version in metadata, exiting") + sys.exit() setNightlyTags(ghcup_metadata) ghcup_metadata['ghcupDownloads']['GHC'][args.version] = new_yaml print(yaml.dump(ghcup_metadata)) ===================================== compiler/GHC/Builtin/Types/Prim.hs ===================================== @@ -1002,26 +1002,29 @@ doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName doubleRepDataConTy Note [The equality types story] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -GHC sports a veritable menagerie of equality types: - - Type or Lifted? Hetero? Role Built in Defining module - class? L/U TyCon ------------------------------------------------------------------------------------------ -~# T U hetero nominal eqPrimTyCon GHC.Prim -~~ C L hetero nominal heqTyCon GHC.Types -~ C L homo nominal eqTyCon GHC.Types -:~: T L homo nominal (not built-in) Data.Type.Equality -:~~: T L hetero nominal (not built-in) Data.Type.Equality - -~R# T U hetero repr eqReprPrimTy GHC.Prim -Coercible C L homo repr coercibleTyCon GHC.Types -Coercion T L homo repr (not built-in) Data.Type.Coercion -~P# T U hetero phantom eqPhantPrimTyCon GHC.Prim +GHC sports a veritable menagerie of equality types. + + Result kind Hetero? Role Built in Defining module +--------------------------------------------------------------------------------- +~# Constraint# hetero nominal eqPrimTyCon GHC.Prim +~~ Constraint hetero nominal heqTyCon GHC.Types +~ Constraint homo nominal eqTyCon GHC.Types +:~: Type homo nominal (not built-in) Data.Type.Equality +:~~: Type hetero nominal (not built-in) Data.Type.Equality + +~R# Constraint# hetero repr eqReprPrimTy GHC.Prim +Coercible Constraint homo repr coercibleTyCon GHC.Types +Coercion Type homo repr (not built-in) Data.Type.Coercion +~P# Constraint# hetero phantom eqPhantPrimTyCon GHC.Prim + +Here `Constraint#` means `CONSTRAINT (TupleRep [])`, a constraint kind that is +represented by a zero-width tuple. Recall that "hetero" means the equality can related types of different kinds. Knowing that (t1 ~# t2) or (t1 ~R# t2) or even that (t1 ~P# t2) also means that (k1 ~# k2), where (t1 :: k1) and (t2 :: k2). + To produce less confusion for end users, when not dumping and without -fprint-equality-relations, each of these groups is printed as the bottommost listed equality. That is, (~#) and (~~) are both rendered as (~) in @@ -1030,7 +1033,7 @@ error messages, and (~R#) is rendered as Coercible. Let's take these one at a time: -------------------------- - (~#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[]) + (~#) :: forall k1 k2. k1 -> k2 -> CONSTRAINT (TupleRep '[]) -------------------------- This is The Type Of Equality in GHC. It classifies nominal coercions. This type is used in the solver for recording equality constraints. @@ -1054,8 +1057,6 @@ This is (almost) an ordinary class, defined as if by Here's what's unusual about it: * We can't actually declare it that way because we don't have syntax for ~#. - And ~# isn't a constraint, so even if we could write it, it wouldn't kind - check. * Users cannot write instances of it. @@ -1112,7 +1113,7 @@ They are not defined within GHC at all. -------------------------- - (~R#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[]) + (~R#) :: forall k1 k2. k1 -> k2 -> CONSTRAINT (TupleRep '[]) -------------------------- The is the representational analogue of ~#. This is the type of representational equalities that the solver works on. All wanted constraints of this type are @@ -1147,7 +1148,7 @@ within GHC at all. -------------------------- - (~P#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep '[]) + (~P#) :: forall k1 k2. k1 -> k2 -> CONSTRAINT (TupleRep '[]) -------------------------- This is the phantom analogue of ~# and it is barely used at all. (The solver has no idea about this one.) Here is the motivation: ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -292,14 +292,14 @@ noParens :: SDoc -> SDoc noParens pp = pp pprOptCo :: Coercion -> SDoc --- Print a coercion optionally; i.e. honouring -dsuppress-coercions -pprOptCo co = sdocOption sdocSuppressCoercions $ \case - True -> angleBrackets (text "Co:" <> int (coercionSize co)) <+> dcolon <+> co_type - False -> parens $ sep [ppr co, dcolon <+> co_type] - where - co_type = sdocOption sdocSuppressCoercionTypes $ \case - True -> ellipsis - False -> ppr (coercionType co) +-- Print a coercion with its type (unless suppressed by -dsuppress-coercion-types) +-- Honour -dsuppress-coercions +-- Placed here because it needs GHC.Core.Coercion.coercionType +pprOptCo co = sdocOption sdocSuppressCoercionTypes $ \case + True -> pprParendCo co + False -> parens (sep [pprCo co, dcolon <+> pp_co_type]) + where + pp_co_type = ppr (coercionType co) ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc ppr_id_occ add_par id ===================================== compiler/GHC/Core/TyCo/Ppr.hs ===================================== @@ -132,8 +132,14 @@ tidyToIfaceTypeX env ty = toIfaceTypeX (mkVarSet free_tcvs) (tidyType env' ty) ------------ pprCo, pprParendCo :: Coercion -> SDoc -pprCo co = getPprStyle $ \ sty -> pprIfaceCoercion (tidyToIfaceCoSty co sty) -pprParendCo co = getPprStyle $ \ sty -> pprParendIfaceCoercion (tidyToIfaceCoSty co sty) +-- Print a coercion without its type +-- Honour -dsuppress-coercions +pprCo co = sdocOption sdocSuppressCoercions $ \case + True -> angleBrackets (text "Co:" <> int (coercionSize co)) + False -> getPprStyle $ \ sty -> pprIfaceCoercion (tidyToIfaceCoSty co sty) +pprParendCo co = sdocOption sdocSuppressCoercions $ \case + True -> angleBrackets (text "Co:" <> int (coercionSize co)) + False -> getPprStyle $ \ sty -> pprParendIfaceCoercion (tidyToIfaceCoSty co sty) tidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion tidyToIfaceCoSty co sty ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1640,7 +1640,7 @@ Here, co3 = UnivCo ProofIrrelProv Nominal (CoercionTy co1) (CoercionTy co2) [co5] where co5 :: (a1 ~# Bool) ~# (a2 ~# Bool) - co5 = TyConAppCo Nominal (~#) [<Consraint#>, <Constraint#>, co4, <Bool>] + co5 = TyConAppCo Nominal (~#) [<Constraint#>, <Constraint#>, co4, <Bool>] Note [The importance of tracking UnivCo dependencies] ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -99,6 +99,7 @@ module GHC.Driver.Backend , backendPostHscPipeline , backendNormalSuccessorPhase , backendName + , backendInfoTableMapValidity , backendValidityOfCImport , backendValidityOfCExport @@ -117,7 +118,6 @@ import GHC.Driver.Phases import GHC.Utils.Error -import GHC.Utils.Panic import GHC.Driver.Pipeline.Monad import GHC.Platform @@ -368,7 +368,8 @@ data PrimitiveImplementation -- We expect one function per back end—or more precisely, one function -- for each back end that writes code to a file. (The interpreter -- does not write to files; its output lives only in memory.) - +-- +-- See Note [Backend Defunctionalization] data DefunctionalizedCodeOutput = NcgCodeOutput | ViaCCodeOutput @@ -680,6 +681,18 @@ backendSupportsBreakpoints = \case Named Bytecode -> True Named NoBackend -> False +-- | Return is 'IsValid' if the backend supports @-finfo-table-map@. +-- If 'backendInfoTableMapValidity' returns 'NotValid', then the driver ignores +-- the flag @-finfo-table-map@, since the backend doesn't support generating +-- the info table map. +backendInfoTableMapValidity :: Backend -> Validity' String +backendInfoTableMapValidity (Named NCG) = IsValid +backendInfoTableMapValidity (Named LLVM) = NotValid "-finfo-table-map is incompatible with -fllvm and is disabled (See #26435)" +backendInfoTableMapValidity (Named ViaC) = IsValid +backendInfoTableMapValidity (Named JavaScript) = NotValid "-finfo-table-map is incompatible with the javascript backend" +backendInfoTableMapValidity (Named Bytecode) = IsValid -- We are not generating any objects, so @-finfo-table-map@ is not expected to work. Avoid warning for GHCi. +backendInfoTableMapValidity (Named NoBackend) = IsValid -- We are not generating code, so we ignore it any way + -- | If this flag is set, then the driver forces the -- optimization level to 0, issuing a warning message if -- the command line requested a higher optimization level. @@ -768,20 +781,33 @@ backendCDefs (Named NoBackend) = NoCDefs -- > -> Set UnitId -- ^ dependencies -- > -> Stream IO RawCmmGroup a -- results from `StgToCmm` -- > -> IO a -backendCodeOutput :: Backend -> DefunctionalizedCodeOutput -backendCodeOutput (Named NCG) = NcgCodeOutput -backendCodeOutput (Named LLVM) = LlvmCodeOutput -backendCodeOutput (Named ViaC) = ViaCCodeOutput -backendCodeOutput (Named JavaScript) = JSCodeOutput -backendCodeOutput (Named Bytecode) = panic "backendCodeOutput: bytecodeBackend" -backendCodeOutput (Named NoBackend) = panic "backendCodeOutput: noBackend" +-- +-- See Note [Backend Defunctionalization] +-- +-- === __WARNING__ +-- +-- Do NOT use 'backendCodeOutput' (or other functions in this module) as a +-- proxy for the 'Backend', which is __abstract by design__. +-- +-- If you need to determine some property of the backend, do NOT match on +-- 'DefunctionalizedCodeOutput'; Instead, write a new property predicate in +-- this module. This makes it easier to add new backends because essentially +-- all backend properties depended upon throughout the compiler are all found +-- here. +backendCodeOutput :: Backend -> Maybe DefunctionalizedCodeOutput +backendCodeOutput (Named NCG) = Just NcgCodeOutput +backendCodeOutput (Named LLVM) = Just LlvmCodeOutput +backendCodeOutput (Named ViaC) = Just ViaCCodeOutput +backendCodeOutput (Named JavaScript) = Just JSCodeOutput +backendCodeOutput (Named Bytecode) = Nothing +backendCodeOutput (Named NoBackend) = Nothing backendUseJSLinker :: Backend -> Bool backendUseJSLinker (Named NCG) = False backendUseJSLinker (Named LLVM) = False backendUseJSLinker (Named ViaC) = False backendUseJSLinker (Named JavaScript) = True -backendUseJSLinker (Named Bytecode) = False +backendUseJSLinker (Named Bytecode) = False backendUseJSLinker (Named NoBackend) = False -- | This (defunctionalized) function tells the compiler ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -4,7 +4,6 @@ \section{Code output phase} -} - module GHC.Driver.CodeOutput ( codeOutput , outputForeignStubs @@ -50,7 +49,7 @@ import GHC.Utils.Outputable import GHC.Utils.Logger import GHC.Utils.Exception ( bracket ) import GHC.Utils.Ppr (Mode(..)) -import GHC.Utils.Panic.Plain ( pgmError ) +import GHC.Utils.Panic.Plain ( panic, pgmError ) import GHC.Unit import GHC.Unit.Finder ( mkStubPaths ) @@ -124,11 +123,12 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g ; let dus1 = newTagDUniqSupply CodeGenTag dus0 ; (stubs, a) <- case backendCodeOutput (backend dflags) of - NcgCodeOutput -> outputAsm logger dflags this_mod location filenm dus1 - final_stream - ViaCCodeOutput -> outputC logger dflags filenm dus1 final_stream pkg_deps - LlvmCodeOutput -> outputLlvm logger llvm_config dflags filenm dus1 final_stream - JSCodeOutput -> outputJS logger llvm_config dflags filenm final_stream + Just NcgCodeOutput -> outputAsm logger dflags this_mod location filenm dus1 + final_stream + Just ViaCCodeOutput -> outputC logger dflags filenm dus1 final_stream pkg_deps + Just LlvmCodeOutput -> outputLlvm logger llvm_config dflags filenm dus1 final_stream + Just JSCodeOutput -> outputJS logger llvm_config dflags filenm final_stream + Nothing -> panic $ "backendCodeOutput: " ++ show (backend dflags) ++ " doesn't support code output" ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod location stubs ; return (filenm, stubs_exist, foreign_fps, a) } ===================================== compiler/GHC/Driver/Main/Compile.hs ===================================== @@ -670,7 +670,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do -- next withTiming after this will be "Assembler" (hard code only). withTiming logger (text "CodeGen"<+>brackets (ppr this_mod)) (const ()) $ case backendCodeOutput (backend dflags) of - JSCodeOutput -> + Just JSCodeOutput -> do let js_config = initStgToJSConfig dflags @@ -696,7 +696,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do stgToJS logger js_config stg_binds this_mod spt_entries foreign_stubs0 cost_centre_info output_filename return (output_filename, stub_c_exists, foreign_fps, Just stg_cg_infos, Just cmm_cg_infos) - _ -> + Just _ -> do cmms <- {-# SCC "StgToCmm" #-} doCodeGen hsc_env this_mod denv tycons @@ -724,6 +724,7 @@ hscGenHardCode hsc_env cgguts mod_loc output_filename = do foreign_stubs foreign_files dependencies (initDUniqSupply 'n' 0) rawcmms1 return ( output_filename, stub_c_exists, foreign_fps , Just stg_cg_infos, Just cmm_cg_infos) + Nothing -> panic $ "backendCodeOutput: " ++ show (backend dflags) ++ " doesn't support code output" -- The part of CgGuts that we need for HscInteractive ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -741,7 +741,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do let home_unit = hsc_home_unit hsc_env case backendCodeOutput (backend dflags) of - JSCodeOutput -> do + Just JSCodeOutput -> do empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let src = ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode src)) @@ -750,7 +750,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do _ <- runPipeline (hsc_hooks hsc_env) pipeline pure () - _ -> do + Just _ -> do empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" let src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;" writeFile empty_stub (showSDoc dflags (pprCode src)) @@ -758,6 +758,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub _ <- runPipeline (hsc_hooks hsc_env) pipeline pure () + Nothing -> panic $ "backendCodeOutput: " ++ show (backend dflags) ++ " doesn't support code output" ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -276,7 +276,7 @@ import GHC.Data.FastString import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable -import GHC.Utils.Error (emptyDiagOpts, logInfo) +import GHC.Utils.Error (emptyDiagOpts, logInfo, Validity'(..)) import GHC.Settings import GHC.CmmToAsm.CFG.Weight import GHC.Core.Opt.CallerCC @@ -3855,8 +3855,8 @@ makeDynFlagsConsistent dflags && os == OSMinGW32 && arch == ArchAArch64 = case backendCodeOutput (backend dflags) of - LlvmCodeOutput -> pgmError "-fllvm is incompatible with enabled TablesNextToCode at Windows Aarch64" - NcgCodeOutput -> pgmError "-fasm is incompatible with enabled TablesNextToCode at Windows Aarch64" + Just LlvmCodeOutput -> pgmError "-fllvm is incompatible with enabled TablesNextToCode at Windows Aarch64" + Just NcgCodeOutput -> pgmError "-fasm is incompatible with enabled TablesNextToCode at Windows Aarch64" _ -> (dflags, mempty, mempty) -- When we do ghci, force using dyn ways if the target RTS linker @@ -3902,9 +3902,8 @@ makeDynFlagsConsistent dflags in dflags_c | gopt Opt_InfoTableMap dflags - , LlvmCodeOutput <- backendCodeOutput (backend dflags) - = loop (gopt_unset dflags Opt_InfoTableMap) - "-finfo-table-map is incompatible with -fllvm and is disabled (See #26435)" + , NotValid msg <- backendInfoTableMapValidity (backend dflags) + = loop (gopt_unset dflags Opt_InfoTableMap) msg | otherwise = (dflags, mempty, mempty) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") ===================================== testsuite/tests/codeGen/should_compile/T25177.stderr ===================================== @@ -11,7 +11,7 @@ lvl = foo d bar1 = \ x eta -> case lvl of { W# ipv -> (# eta, () #) } -bar = bar1 `cast` <Co:6> :: ... +bar = bar1 `cast` <Co:6> ===================================== testsuite/tests/deSugar/should_fail/all.T ===================================== @@ -6,7 +6,9 @@ test('DsStrictFail', exit_code(1), compile_and_run, ['']) test( 'T21701', - [omit_ways(llvm_ways)], # -finfo-table-map does not work with -fllvm (#26435) + [ omit_ways(llvm_ways), # -finfo-table-map does not work with -fllvm (#26435) + when(js_arch(), skip) # javascript doesn't support -finfo-table-map yet and yields a warning we don't want to handle here + ], compile, ['-Wall -finfo-table-map'] ) ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -385,6 +385,14 @@ test('ListTuplePunsPpr', normal, ghci_script, ['ListTuplePunsPpr.script']) test('ListTuplePunsPprNoAbbrevTuple', [limit_stdout_lines(14)], ghci_script, ['ListTuplePunsPprNoAbbrevTuple.script']) test('T24459', normal, ghci_script, ['T24459.script']) test('T24632', normal, ghci_script, ['T24632.script']) +# bytecode backend doesn't support '-finfo-table-map' (#27039) +test('bytecodeIPE', + [ extra_hc_opts('-finfo-table-map') + , extra_files(['bytecodeIPE.hs']) + , req_rts_linker + , when(arch('wasm32') or arch('javascript'), skip) + ], + ghci_script, ['bytecodeIPE.script']) # Test package renaming in GHCi session test('GhciPackageRename', ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.hs ===================================== @@ -0,0 +1,12 @@ +module BytecodeIPE where + +import Data.Maybe (isJust) +import GHC.InfoProv (whereFrom) + +marker :: String +marker = id "bytecode-stub-init" +{-# NOINLINE marker #-} + +-- `whereFrom` only succeeds if the module's IPE initializer ran. +probe :: IO Bool +probe = isJust <$> whereFrom marker ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.script ===================================== @@ -0,0 +1,2 @@ +:load bytecodeIPE.hs +probe ===================================== testsuite/tests/ghci/scripts/bytecodeIPE.stdout ===================================== @@ -0,0 +1 @@ +False ===================================== testsuite/tests/numeric/should_compile/T15547.stderr ===================================== @@ -5,25 +5,25 @@ Result size of Tidy Core nat2Word# = \ @n $dKnownNat p1 -> - naturalToWord# ((natSing $dKnownNat) `cast` <Co:2> :: ...) + naturalToWord# ((natSing $dKnownNat) `cast` <Co:2>) foo = \ ds -> 18## fd = \ @n $dKnownNat ds -> - naturalToWord# ((natSing $dKnownNat) `cast` <Co:6> :: ...) + naturalToWord# ((natSing $dKnownNat) `cast` <Co:6>) d = \ ds -> 3## fm = \ @n $dKnownNat ds -> - naturalToWord# ((natSing $dKnownNat) `cast` <Co:8> :: ...) + naturalToWord# ((natSing $dKnownNat) `cast` <Co:8>) m = \ ds -> 9## fp = \ @n $dKnownNat ds -> - naturalToWord# ((natSing $dKnownNat) `cast` <Co:10> :: ...) + naturalToWord# ((natSing $dKnownNat) `cast` <Co:10>) p = \ ds -> 512## ===================================== testsuite/tests/simplCore/should_compile/DataToTagFamilyScrut.stderr ===================================== @@ -5,7 +5,7 @@ Result size of Tidy Core testFun = \ @x v -> - case v `cast` <Co:2> :: ... of { + case v `cast` <Co:2> of { __DEFAULT -> 47#; C0 ipv -> -3#; C2 -> 13#; ===================================== testsuite/tests/simplCore/should_compile/T14978.stdout ===================================== @@ -1,2 +1,2 @@ foo :: Goof Int -foo = T14978.Goof @Int @~<Co:1> :: Int GHC.Internal.Prim.~# Int +foo = T14978.Goof @Int @~(<Co:1> :: Int GHC.Internal.Prim.~# Int) ===================================== testsuite/tests/simplCore/should_compile/T18013.stderr ===================================== @@ -161,11 +161,11 @@ T18013.$wmapMaybeRule @s @(Maybe b) ww2 (GHC.Internal.Maybe.Nothing @b) #); Just x -> case ((wild s2 x) - `cast` <Co:4> :: IO (Result s b) - ~R# (GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# - GHC.Internal.Prim.RealWorld, - Result s b #))) + `cast` (<Co:4> + :: IO (Result s b) + ~R# (GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld + -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, + Result s b #)))) s1 of { (# ipv, ipv1 #) -> @@ -175,12 +175,13 @@ T18013.$wmapMaybeRule } } }) - `cast` <Co:13> :: (s - -> Maybe a - -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld - -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, - Result s (Maybe b) #)) - ~R# (s -> Maybe a -> IO (Result s (Maybe b)))) + `cast` (<Co:13> + :: (s + -> Maybe a + -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld + -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, + Result s (Maybe b) #)) + ~R# (s -> Maybe a -> IO (Result s (Maybe b))))) } } ===================================== testsuite/tests/simplCore/should_compile/T24229a.stderr ===================================== @@ -15,8 +15,8 @@ foo = \ @a ds ds1 -> case ds of { I# ww -> case ww of ds2 { - __DEFAULT -> case ds1 `cast` <Co:4> :: ... of { (x, y) -> case foo_$s$wfoo (-# ds2 1#) y x of { (# ww1 #) -> Just ww1 } }; - 0# -> Just (ds1 `cast` <Co:4> :: ...) + __DEFAULT -> case ds1 `cast` <Co:4> of { (x, y) -> case foo_$s$wfoo (-# ds2 1#) y x of { (# ww1 #) -> Just ww1 } }; + 0# -> Just (ds1 `cast` <Co:4>) } } ===================================== testsuite/tests/simplCore/should_compile/T24229b.stderr ===================================== @@ -15,8 +15,8 @@ foo = \ @a ds ds1 -> case ds of { I# ww -> case ww of ds2 { - __DEFAULT -> case ds1 `cast` <Co:4> :: ... of { (x, y) -> case foo_$s$wfoo (-# ds2 1#) y x of { (# ww1 #) -> Just ww1 } }; - 0# -> Just (ds1 `cast` <Co:4> :: ...) + __DEFAULT -> case ds1 `cast` <Co:4> of { (x, y) -> case foo_$s$wfoo (-# ds2 1#) y x of { (# ww1 #) -> Just ww1 } }; + 0# -> Just (ds1 `cast` <Co:4>) } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d26601c502e8ee912061fc5e3a88b4e... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d26601c502e8ee912061fc5e3a88b4e... You're receiving this email because of your account on gitlab.haskell.org.