- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/spj-apporv-Oct24] revert back rep-poly err messages
by Apoorv Ingle (＠ani) 30 Mar '26

30 Mar '26

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 50f0aaae by Apoorv Ingle at 2026-03-30T14:14:47-05:00 revert back rep-poly err messages - - - - - 5 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Types/Origin.hs - testsuite/tests/rep-poly/RepPolyDoBind.stderr - testsuite/tests/rep-poly/RepPolyDoBody1.stderr - testsuite/tests/rep-poly/RepPolyDoBody2.stderr Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -916,7 +916,7 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> ExpectedFunTyCtxt mk_herald tc_fun arg = case fun_orig of - DoStmtOrigin -> ExpectedTySyntax DoStmtOrigin arg + DoStmtOrigin -> ExpectedFunTySyntaxOp DoStmtOrigin tc_fun _ -> ExpectedFunTyArg (HsExprTcThing tc_fun) arg -- Is the argument supposed to instantiate a forall? ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -1536,13 +1536,6 @@ data ExpectedFunTyCtxt => ExpectedFunTySyntaxOp !CtOrigin !(HsExpr (GhcPass p)) -- ^ rebindable syntax operator - -- | A rebindable syntax operator is expected to have a function type. - -- - -- Test cases for representation-polymorphism checks: - -- RepPolyDoBind, RepPolyDoBody{1,2}, - -- This constructor will merge with ExpectedFunTySyntaxOp when tcSyntaxOp is retired. - | ExpectedTySyntax !CtOrigin !(HsExpr GhcRn) - -- | A view pattern must have a function type. -- -- Test cases for representation-polymorphism checks: @@ -1598,9 +1591,6 @@ pprExpectedFunTyCtxt funTy_origin i = , text "the rebindable syntax operator" , quotes (ppr op) ] , nest 2 (ppr orig) ] - ExpectedTySyntax orig arg -> - vcat [ text "The expression" <+> quotes (ppr arg) - , nest 2 (ppr orig) ] ExpectedFunTyViewPat expr -> vcat [ the_arg_of <+> text "the view pattern" , nest 2 (ppr expr) ] @@ -1629,8 +1619,6 @@ pprExpectedFunTyCtxt funTy_origin i = pprExpectedFunTyHerald :: ExpectedFunTyCtxt -> SDoc pprExpectedFunTyHerald (ExpectedFunTySyntaxOp {}) = text "This rebindable syntax expects a function with" -pprExpectedFunTyHerald (ExpectedTySyntax orig _) - = pprCtOriginBriefly orig pprExpectedFunTyHerald (ExpectedFunTyViewPat {}) = text "A view pattern expression expects" pprExpectedFunTyHerald (ExpectedFunTyArg fun _) ===================================== testsuite/tests/rep-poly/RepPolyDoBind.stderr ===================================== @@ -1,5 +1,5 @@ RepPolyDoBind.hs:26:3: error: [GHC-55287] - • The expression ‘undefined’ + • The first argument of the rebindable syntax operator ‘(>>=)’ arising from a do statement does not have a fixed runtime representation. Its type is: ===================================== testsuite/tests/rep-poly/RepPolyDoBody1.stderr ===================================== @@ -1,5 +1,5 @@ RepPolyDoBody1.hs:24:3: error: [GHC-55287] - • The expression ‘undefined :: ma’ + • The first argument of the rebindable syntax operator ‘(>>)’ arising from a do statement does not have a fixed runtime representation. Its type is: ===================================== testsuite/tests/rep-poly/RepPolyDoBody2.stderr ===================================== @@ -1,5 +1,5 @@ RepPolyDoBody2.hs:23:3: error: [GHC-55287] - • The expression ‘return ()’ + • The first argument of the rebindable syntax operator ‘(>>)’ arising from a do statement does not have a fixed runtime representation. Its type is: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50f0aaae7c21d7108cff352ec7e64b9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50f0aaae7c21d7108cff352ec7e64b9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/libDir-setting] Add config setting for LibDir
by Sven Tennie (＠supersven) 30 Mar '26

30 Mar '26

Sven Tennie pushed to branch wip/supersven/libDir-setting at Glasgow Haskell Compiler / GHC Commits: 20a2b55a by Sven Tennie at 2026-03-30T19:31:43+02:00 Add config setting for LibDir Previously, the libDir was derived from topDir. This won't work for inplace stage2 cross-compilers where binaries and libraries are in different stage dirs (`_build/stage1/` for executables and `_build/stage2` for libraries). - - - - - 7 changed files: - compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - hadrian/bindist/Makefile - hadrian/src/Rules/Generate.hs Changes: ===================================== compiler/GHC/Driver/Config/Interpreter.hs ===================================== @@ -17,8 +17,8 @@ import System.Directory initInterpOpts :: DynFlags -> IO InterpOpts initInterpOpts dflags = do - wasm_dyld <- makeAbsolute $ topDir dflags </> "dyld.mjs" - js_interp <- makeAbsolute $ topDir dflags </> "ghc-interp.js" + wasm_dyld <- makeAbsolute $ libDir dflags </> "dyld.mjs" + js_interp <- makeAbsolute $ libDir dflags </> "ghc-interp.js" pure $ InterpOpts { interpExternal = gopt Opt_ExternalInterpreter dflags , interpProg = pgm_i dflags ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -60,7 +60,7 @@ module GHC.Driver.DynFlags ( -- ** System tool settings and locations programName, projectVersion, - ghcUsagePath, ghciUsagePath, topDir, toolDir, + ghcUsagePath, ghciUsagePath, topDir, libDir, toolDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, @@ -1508,6 +1508,8 @@ ghciUsagePath :: DynFlags -> FilePath ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags topDir :: DynFlags -> FilePath topDir dflags = fileSettings_topDir $ fileSettings dflags +libDir :: DynFlags -> FilePath +libDir dflags = fileSettings_libDir $ fileSettings dflags toolDir :: DynFlags -> Maybe FilePath toolDir dflags = fileSettings_toolDir $ fileSettings dflags extraGccViaCFlags :: DynFlags -> [String] ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3650,7 +3650,6 @@ compilerInfo dflags -- Whether or not GHC was compiled using -prof ("GHC Profiled", showBool hostIsProfiled), ("Debug on", showBool debugIsOn), - ("LibDir", topDir dflags), -- This is always an absolute path, unlike "Relative Global Package DB" which is -- in the settings file. ("Global Package DB", globalPackageDatabasePath dflags) ===================================== compiler/GHC/Settings.hs ===================================== @@ -184,6 +184,7 @@ data FileSettings = FileSettings , fileSettings_toolDir :: Maybe FilePath -- ditto , fileSettings_topDir :: FilePath -- ditto , fileSettings_globalPackageDatabase :: FilePath + , fileSettings_libDir :: FilePath } ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -148,6 +148,8 @@ initSettings top_dir = do baseUnitId <- getSetting_raw "base unit-id" + lib_dir <- getSetting "LibDir" + return $ Settings { sGhcNameVersion = GhcNameVersion { ghcNameVersion_programName = "ghc" @@ -159,6 +161,7 @@ initSettings top_dir = do , fileSettings_ghciUsagePath = ghci_usage_msg_path , fileSettings_toolDir = mtool_dir , fileSettings_topDir = top_dir + , fileSettings_libDir = lib_dir , fileSettings_globalPackageDatabase = globalpkgdb_path } ===================================== hadrian/bindist/Makefile ===================================== @@ -90,6 +90,7 @@ lib/settings : config.mk @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@ @echo ',("Relative Global Package DB", "package.conf.d")' >> $@ @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ + @echo ',("LibDir", "$$topdir")' >> $@ @echo "]" >> $@ lib/targets/default.target : config.mk default.target ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -25,6 +25,7 @@ import Utilities import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp)) import GHC.Platform.ArchOS import Settings.Program (ghcWithInterpreter) +import Hadrian.Oracles.Path -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () @@ -476,6 +477,16 @@ generateSettings settingsFile = do Stage3 -> pkgUnitId Stage2 base let rel_pkg_db = makeRelativeNoSysLink (dropFileName settingsFile) package_db_path + make_absolute rel_path = do + abs_path <- liftIO (makeAbsolute rel_path) + fixAbsolutePathOnWindows abs_path + + -- E.g. the Stage2 compiler lives in _build/stage1 + -- So, we need to decrement the stage to get the correct directory + stage_dir_stage = predStage stage + + rel_lib_topDir :: FilePath <- expr $ stageLibPath stage_dir_stage + lib_topDir :: FilePath <- expr $ make_absolute rel_lib_topDir settings <- traverse sequence $ [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) @@ -483,6 +494,7 @@ generateSettings settingsFile = do , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) , ("Relative Global Package DB", pure rel_pkg_db) , ("base unit-id", pure base_unit_id) + , ("LibDir", pure lib_topDir) ] let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" pure $ case settings of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20a2b55aae5670a497309473028c71d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20a2b55aae5670a497309473028c71d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-reinstallable-base] More [skip ci]
by Simon Peyton Jones (＠simonpj) 30 Mar '26

30 Mar '26

Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC Commits: 545fa306 by Simon Peyton Jones at 2026-03-30T17:49:23+01:00 More [skip ci] - - - - - 6 changed files: - compiler/GHC/Builtin/Names.hs - libraries/base/src/Data/List.hs - libraries/base/src/GHC/KnownKeyNames.hs - libraries/base/src/GHC/Stats.hs - libraries/base/src/System/Exit.hs - libraries/base/src/System/IO/OS.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -263,7 +263,8 @@ basicKnownKeyTable , (mkTcOcc "HasField", hasFieldClassKey) , (mkVarOcc "fromLabel", fromLabelClassOpKey) , (mkVarOcc "getField", getFieldClassOpKey) - , (mkVarOcc "setField", setFieldClassOpKey) + -- setField is not yet defined in ghc-internal + -- , (mkVarOcc "setField", setFieldClassOpKey) -- FromList , (mkVarOcc "fromList", fromListClassOpKey) ===================================== libraries/base/src/Data/List.hs ===================================== @@ -193,7 +193,7 @@ import GHC.Internal.Int (Int) import GHC.Internal.Num ((-)) import GHC.List (build) import qualified Data.List.NubOrdSet as NubOrdSet -import GHC.Internal.Num( Num ) -- For -frebindable-known-key-names (defaulting) +import GHC.Internal.Num( Num, fromInteger ) -- For -frebindable-known-key-names (defaulting) inits1, tails1 :: [a] -> [NonEmpty a] ===================================== libraries/base/src/GHC/KnownKeyNames.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE Trustworthy #-} + -- | -- -- Module : GHC.KnownKeyNames @@ -12,18 +14,28 @@ module GHC.KnownKeyNames ( Rational , Eq, (==) , Ord, Show - , Num, (-), negate - , Integral + , Ix , Enum, Bounded , Foldable, Traversable - , IsString + , Data , Functor, fmap , Monad, (>>), (>>=), return, fail, guard, mfix, join , Applicative, mzip, (<*>) + , Alternative + , Semigroup, Monoid , (<>), mappend + -- Numbers + , Num, Integral + , (-), negate, fromInteger, fromRational + + -- Strings + , IsString + , fromString + -- Records and lists - , fromlabel, getField, setField + , HasField + , fromLabel, getField , fromList, fromListN, toList -- Arrows @@ -35,11 +47,15 @@ module GHC.KnownKeyNames import Prelude import Data.String( IsString ) -import GHC.Internal.Base( join ) +import GHC.Internal.Base( Alternative, join, thenIO, bindIO, returnIO ) +import GHC.Internal.Ix( Ix ) +import GHC.Internal.Data.Data( Data ) +import GHC.Internal.Data.String( fromString ) +import GHC.Internal.Real( mkRationalBase2, mkRationalBase10 ) import GHC.Internal.Control.Monad( guard ) -import GHC.Internal.Control.Monad.Fix( mfix ) +import GHC.Internal.Control.Monad.Fix( mfix, loop ) import GHC.Internal.Control.Monad.Zip( mzip ) import GHC.Internal.Control.Arrow( arr, (>>>), first, app, (|||) ) import GHC.Internal.OverloadedLabels( fromLabel ) -import GHC.Internal.Records( getField, setField ) +import GHC.Internal.Records( HasField, getField ) import GHC.Internal.IsList( fromList, fromListN, toList ) ===================================== libraries/base/src/GHC/Stats.hs ===================================== @@ -43,6 +43,7 @@ import qualified GHC.Internal.Stats as Internal import GHC.Generics (Generic) import Data.Word (Word64,Word32) import Data.Int (Int64) +import Prelude( (>>=), (>>) ) -- For known-key names -- | Time values from the RTS, using a fixed resolution of nanoseconds. type RtsTime = Int64 ===================================== libraries/base/src/System/Exit.hs ===================================== @@ -35,6 +35,7 @@ import Data.String (String) import Data.Eq ((/=)) import System.IO (IO, hPutStrLn, stderr) import GHC.Internal.Num( Num ) -- For -frebindable-known-key-names (defaulting) +import GHC.Internal.Num( fromInteger ) -- For known-key names -- --------------------------------------------------------------------------- -- exitWith ===================================== libraries/base/src/System/IO/OS.hs ===================================== @@ -23,6 +23,8 @@ module System.IO.OS ) where +import GHC.KnownKeyNames + import Control.Monad (return) import Control.Concurrent.MVar (MVar) import Control.Exception (mask) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/545fa3065669fb33613a5762d06dbb7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/545fa3065669fb33613a5762d06dbb7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ani/no-ds-flag-cache] More wibbles
by Simon Peyton Jones (＠simonpj) 30 Mar '26

30 Mar '26

Simon Peyton Jones pushed to branch wip/ani/no-ds-flag-cache at Glasgow Haskell Compiler / GHC Commits: b5adc452 by Simon Peyton Jones at 2026-03-30T17:45:43+01:00 More wibbles - - - - - 4 changed files: - compiler/GHC/Tc/Gen/App.hs - − compiler/GHC/Tc/Gen/App.hs-boot - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -11,7 +11,6 @@ module GHC.Tc.Gen.App ( tcApp - , tcExprSigma , tcExprPrag ) where import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr ) @@ -165,34 +164,6 @@ Note [Instantiation variables are short lived] -} -{- ********************************************************************* -* * - tcInferSigma -* * -********************************************************************* -} - --- Very similar to tcApp, but returns a sigma (uninstantiated) type --- CAUTION: Any changes to tcApp should be reflected here --- cf. T19167. the head is an expanded expression applied to a type --- Caution: Currently we assume that the expression is compiler generated/expanded --- Because that is what T19167 test case expects. --- This function should go away after MR!15778 lands -tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) -tcExprSigma inst fun_orig rn_expr - = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr - ; do_ql <- wantQuickLook rn_fun - ; (tc_fun, fun_sigma) <- tcInferAppHead fun - ; inGenCode <- inGeneratedCode - ; traceTc "tcExprSigma" (vcat [ text "rn_expr:" <+> ppr rn_expr - , text "tc_fun" <+> ppr tc_fun - , text "inGeneratedCode:" <+> ppr inGenCode]) - ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (fun_orig, rn_fun, fun_lspan) - tc_fun fun_sigma rn_args - ; tc_args <- tcValArgs do_ql (rn_fun, fun_lspan) inst_args - ; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args - ; return (tc_expr, app_res_sigma) } - - {- ********************************************************************* * * Typechecking n-ary applications ===================================== compiler/GHC/Tc/Gen/App.hs-boot deleted ===================================== @@ -1,12 +0,0 @@ -module GHC.Tc.Gen.App where - -import GHC.Hs ( HsExpr ) -import GHC.Tc.Types ( TcM ) -import GHC.Tc.Types.Origin ( CtOrigin ) -import GHC.Tc.Utils.TcType ( TcSigmaType ) -import GHC.Hs.Extension ( GhcRn, GhcTc ) - - -import GHC.Prelude (Bool) - -tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -445,8 +445,7 @@ tcInferAppHead (fun,fun_lspan) do { mb_tc_fun <- tcInferAppHead_maybe fun ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) - Nothing -> tcInferExprSigma fun - + Nothing -> tcInferExprSigma fun } tcInferAppHead_maybe :: HsExpr GhcRn @@ -456,24 +455,11 @@ tcInferAppHead_maybe :: HsExpr GhcRn -- XExpr's although complicated needs to be looked through, useful for QL things when -- the argument is an XExpr tcInferAppHead_maybe fun = case fun of - HsVar _ nm - -> Just <$> tcInferId nm - ExprWithTySig _ e hs_ty - -> Just <$>tcExprWithSig e hs_ty - HsOverLit _ lit - -> Just <$> tcInferOverLit lit - XExpr (HsRecSelRn f) - -> Just <$> tcInferRecSelId f - --- XExpr (ExpandedThingRn (HSE o (L loc e))) --- -> setSrcSpan (locA loc) $ Just <$> --- do { (e', ty) <- tcExprSigma False (hsCtxtCtOrigin o) e --- ; return (mkExpandedTc o (L loc e'), ty) } --- -- We do not want to instantiate the type of the head as there may be --- -- visible type applications in the argument. --- -- c.f. T19167 - _ - -> return Nothing + HsVar _ nm -> Just <$> tcInferId nm + ExprWithTySig _ e hs_ty -> Just <$>tcExprWithSig e hs_ty + HsOverLit _ lit -> Just <$> tcInferOverLit lit + XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f + _ -> return Nothing {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -1261,17 +1261,28 @@ we simply look to see if the hole is filled already. But consider case x of True -> True - False -> error "urk" + False -> undefined and suppose we call `tcInferSigma` on this expression, so that the `ir_inst` field of the expected result type is `IIF_Sigma`. The danger is that we'll fill the hole with `Bool` (from the `True`) and then reject when we try to -unify that with `forall a. a->a`, from the call to `error`. +unify that with `forall a. a->a`, from the call to `undefined`. + +Another example: + case x of + True -> (e1 :: forall a b. a->b) + False -> (e3 :: forall b a. a->b) To avoid this, we never infer a sigma-type from a multi-branch `case`. Instead we just zap the `IIF_Sigma` to `IIF_DeepRho` when walking inside the branches of multi-arm case-expression, or an if-expression. See calls to `adjustExpTypeForCaseBranches`. +This does mean that this would work: + (let x = 77+55 in h x x) @Int +where + h :: Int -> Int -> forall a. a->a +The `@Int` would instantiate the `forall a`. + Note that case e of True -> hr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5adc452444e2fd8ea668fac5bd67fc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5adc452444e2fd8ea668fac5bd67fc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/25636] 2 commits: fixup! Allocate static constructors for bytecode
by Rodrigo Mesquita (＠alt-romes) 30 Mar '26

30 Mar '26

Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC Commits: dacd00dc by Rodrigo Mesquita at 2026-03-30T17:43:34+01:00 fixup! Allocate static constructors for bytecode - - - - - eb40cc66 by Rodrigo Mesquita at 2026-03-30T17:43:34+01:00 fixup! Add float# and subword tests for #25636 - - - - - 17 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Layout.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs - + testsuite/tests/codeGen/should_run/T25636c/T25636c.script - + testsuite/tests/codeGen/should_run/T25636c/T25636c.stdout - + testsuite/tests/codeGen/should_run/T25636c/all.T - + testsuite/tests/codeGen/should_run/T25636d/T25636d.script - + testsuite/tests/codeGen/should_run/T25636d/T25636d.stdout - + testsuite/tests/codeGen/should_run/T25636d/all.T - + testsuite/tests/codeGen/should_run/T25636e/T25636e.script - + testsuite/tests/codeGen/should_run/T25636e/T25636e.stdout - + testsuite/tests/codeGen/should_run/T25636e/all.T Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -78,6 +78,8 @@ import GHC.Exts import GHC.Core.DataCon import GHC.Data.FlatBag import GHC.Types.Id +import Data.List (unfoldr) +import GHC.Types.RepType (typePrimRepU) -- ----------------------------------------------------------------------------- @@ -216,8 +218,9 @@ assembleBCO platform , protoStaticCon = dc , protoStaticConData = args }) = do - let ptrs = foldr mappendFlatBag emptyFlatBag (mapMaybe idBCOArg args) - let nonptrs = foldr mappendFlatBag emptyFlatBag (mapMaybe litBCOArg args) + let fullword_args = packSubwordArgs platform args + let ptrs = foldr mappendFlatBag emptyFlatBag (mapMaybe idBCOArg fullword_args) + let nonptrs = foldr mappendFlatBag emptyFlatBag (mapMaybe litBCOArg fullword_args) pure UnlinkedStaticCon { unlinkedStaticConName = protoStaticConName , unlinkedStaticConDataConName = dataConName dc @@ -226,7 +229,7 @@ assembleBCO platform , unlinkedStaticConIsUnlifted = isUnliftedType (idType (dataConWrapId dc)) } where - litBCOArg (Left l) = Just $ case literal platform l of + litBCOArg (Left l) = Just $ case l of OnlyOne np -> unitFlatBag np OnlyTwo np1 np2 -> TupleFlatBag np1 np2 litBCOArg (Right var) @@ -295,6 +298,69 @@ assembleBCO platform return ul_bco +-- | Pack sub-word literals (which should appear contiguously in the argument +-- list) into full words, and leave full-word-sized arguments alone. +packSubwordArgs :: Platform -> [Either Literal Id] -> [Either (OneOrTwo BCONPtr) Id] +packSubwordArgs platform = map packWord . groupWords + where + -- Assumes packed sub-words are always ordered from largest to smallest literal + packWord :: Either [Literal] Id -> Either (OneOrTwo BCONPtr) Id + packWord (Right v) = Right v -- already word size + packWord (Left [lit]) = Left $ literal platform lit -- single >=word_size literal + packWord (Left lits) = Left $ OnlyOne (BCONPtrWord packedWord) + where + packedWord = go 0 lits + + go :: Int -> [Literal] -> Word + go _ [] = 0 + go offset (l:ls) = + (subwordLiteral l `shiftBy` offset) .|. go (offset + litBits l) ls + + shiftBy :: Word -> Int -> Word + shiftBy w offset = case platformByteOrder platform of + LittleEndian -> w `unsafeShiftL` offset + BigEndian -> w `unsafeShiftR` offset + + subwordLiteral :: Literal -> Word + subwordLiteral l = case literal platform l of + OnlyOne (BCONPtrWord w) -> w + _ -> pprPanic "packSubwordArgs: expected a subword literal to lower to one BCONPtrWord" (ppr l) + + litBits :: Literal -> Int + litBits l = litBytes l * 8 + + -- Group literals into lists of literals making up a full word, where in + -- singleton lists the literal may be larger than a word + -- (e.g. Word64 in 32bit platform) + groupWords :: [Either Literal Id] -> [Either [Literal] Id] + groupWords = unfoldr step + where + step [] = Nothing + step (Right v:xs) = Just (Right v, xs) + step (Left l:xs) = + let (chunk, rest) = takeWord [] (Left l:xs) + in Just (Left chunk, rest) + + -- take subwords from list until a full-word is accumulated + takeWord acc rest + -- reached a full word in the accumulator; exit! + | sum (map litBytes acc) == ws + = (reverse acc, rest) + takeWord [sing] rest + -- a larger than word single lit in the accumulator; exit! + | litBytes sing > ws + = ([sing], rest) + takeWord acc (Left l:ls) + -- contiguous lits should be sub-words of right size to form full + -- word; else, the exit condition is never reached. + = takeWord (l:acc) ls + takeWord acc _ + = pprPanic "packSubwordArgs: Reached Ptr or end of list before forming a full word from contiguous literals." + (text "acc:" <+> ppr acc) + + litBytes = primRepSizeB platform . typePrimRepU . literalType + ws = platformWordSizeInBytes platform + -- | Construct a word-array containing an @StgLargeBitmap@. mkBitmapArray :: Word -> [StgWord] -> UArray Int Word -- Here the return type must be an array of Words, not StgWords, ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -58,8 +58,16 @@ data ProtoBCO -- We use this to construct the right info table. protoStaticConData :: [Either Literal Id], -- ^ The static constructor pointer and non-pointer arguments, sorted - -- in the order they should appear at runtime (see 'mkVirtConstrOffsets'). - -- The pointers always come first, followed by the non-pointers. + -- in the order they should appear at runtime (see + -- 'mkVirtHeapOffsetsWithPadding' in 'schemeTopBind'). + -- + -- The non-pointer arguments are meant to be laid contiguously in + -- memory using the width of each literal individually. The padding is + -- given as Literals of value 0 with the appropriate width. + protoStaticConNonPtrsSize :: Int, + -- ^ How many words needed to store the non-pointer arguments. + -- Note that this may be smaller than the number of non-pointer + -- arguments, since subword arguments need to be packed. protoStaticConExpr :: CgStgRhs -- ^ What the static con came from, for debugging only } @@ -333,11 +341,12 @@ data BCInstr -- Printing bytecode instructions instance Outputable ProtoBCO where - ppr (ProtoStaticCon nm con args origin) + ppr (ProtoStaticCon nm con args nonPtrsSize origin) = text "ProtoStaticCon" <+> ppr nm <> colon $$ nest 3 (pprStgRhsShort shortStgPprOpts origin) $$ nest 3 (text "constructor: " <+> ppr con) $$ nest 3 (text "sorted args: " <+> ppr args) + $$ nest 3 (text "non-ptrs (packed) size: " <+> int (fromIntegral nonPtrsSize) <+> text "words") ppr (ProtoBCO { protoBCOName = name , protoBCOInstrs = instrs , protoBCOBitmap = bitmap ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -271,7 +271,9 @@ data UnlinkedBCO -- confused with the name of the static constructor itself -- ('unlinkedStaticConDataConName') unlinkedStaticConDataConName :: !Name, - unlinkedStaticConLits :: !(FlatBag BCONPtr), -- non-ptrs + unlinkedStaticConLits :: !(FlatBag BCONPtr), + -- ^ non-ptrs full words, where sub-word literals have already been + -- packed into full words as needed unlinkedStaticConPtrs :: !(FlatBag BCOPtr), -- ptrs unlinkedStaticConIsUnlifted :: !Bool } @@ -340,7 +342,7 @@ instance Outputable UnlinkedBCO where = sep [text "StaticCon", ppr nm, text "for", if unl then text "unlifted" else text "lifted", ppr dc_nm, text "with", - ppr (sizeFlatBag lits), text "lits", + ppr (sizeFlatBag lits), text "lits", parens (text "(packed) full words"), ppr (sizeFlatBag ptrs), text "ptrs" ] instance Binary FFIInfo where ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -305,16 +305,25 @@ schemeTopBind :: (Id, CgStgRhs) -> BcM ProtoBCO schemeTopBind (id, rhs@(StgRhsCon _ dc _ _ args _)) = do profile <- getProfile - let non_voids = addArgReps (assertNonVoidStgArgs args) - (_, _, args_offsets) - -- Compute the expected runtime ordering for the datacon fields - = mkVirtConstrOffsets profile non_voids + let + non_voids = addArgReps (assertNonVoidStgArgs args) + (tot_wds, -- #ptr_wds + #nonptr_wds + ptr_wds, -- #ptr_wds + nv_args_w_offsets) = + -- Compute the runtime ordering for the datacon fields + -- (Subword-sized fields are laid out contiguously, and padding is + -- represented as literals of value 0 with the appropriate width) + mkVirtHeapOffsetsWithPadding profile StdHeader non_voids + contiguous_args_with_pad = + litsWithPaddingToLits nv_args_w_offsets + return ProtoStaticCon { protoStaticConName = getName id , protoStaticCon = dc , protoStaticConData = [ case a of StgLitArg l -> Left l StgVarArg i -> Right i - | (NonVoid a, _) <- args_offsets ] + | NonVoid a <- contiguous_args_with_pad ] + , protoStaticConNonPtrsSize = tot_wds - ptr_wds , protoStaticConExpr = rhs } schemeTopBind (id, rhs) ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -100,23 +100,7 @@ cgTopRhsCon cfg id con mn args nv_args_w_offsets) = mkVirtHeapOffsetsWithPadding profile StdHeader (addArgReps args) - ; let - -- Decompose padding into units of length 8, 4, 2, or 1 bytes to - -- allow the implementation of mk_payload to use widthFromBytes, - -- which only handles these cases. - fix_padding (x@(Padding n off) : rest) - | n == 0 = fix_padding rest - | n `elem` [1,2,4,8] = x : fix_padding rest - | testBit n 0 = add_pad 1 - | testBit n 1 = add_pad 2 - | testBit n 2 = add_pad 4 - | otherwise = add_pad 8 - where add_pad m = Padding m off : fix_padding (Padding (n-m) (off+m) : rest) - fix_padding (x : rest) = x : fix_padding rest - fix_padding [] = [] - - mk_payload (Padding len _) = return (CmmInt 0 (widthFromBytes len)) - mk_payload (FieldOff arg _) = do + mk_payload arg = do amode <- getArgAmode arg case amode of CmmLit lit -> return lit @@ -129,8 +113,7 @@ cgTopRhsCon cfg id con mn args -- needs to poke around inside it. info_tbl = mkDataConInfoTable profile con (addModuleLoc this_mod mn) True ptr_wds nonptr_wds - - ; payload <- mapM mk_payload (fix_padding nv_args_w_offsets) + ; payload <- mapM mk_payload (litsWithPaddingToLits nv_args_w_offsets) -- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs -- NB2: all the amodes should be Lits! -- TODO (osa): Why? ===================================== compiler/GHC/StgToCmm/Layout.hs ===================================== @@ -23,6 +23,7 @@ module GHC.StgToCmm.Layout ( mkVirtHeapOffsetsWithPadding, mkVirtConstrOffsets, mkVirtConstrSizes, + litsWithPaddingToLits, getHpRelOffset, ArgRep(..), toArgRep, toArgRepOrV, idArgRep, argRepSizeW, -- re-exported from GHC.StgToCmm.ArgRep @@ -66,6 +67,7 @@ import Control.Monad import GHC.StgToCmm.Config (stgToCmmPlatform) import GHC.StgToCmm.Types import Data.List.NonEmpty (nonEmpty) +import GHC.Types.Literal ------------------------------------------------------------------------ -- Call and return sequences @@ -423,6 +425,10 @@ data FieldOffOrPadding a | Padding ByteOff -- Length of padding in bytes. ByteOff -- Offset in bytes. +instance Outputable a => Outputable (FieldOffOrPadding a) where + ppr (FieldOff (NonVoid a) off) = text "Field" <+> ppr a <+> text "at offset" <+> int off + ppr (Padding size off) = text "Padding of size" <+> int size <+> text "at offset" <+> int off + -- | Used to tell the various @mkVirtHeapOffsets@ functions what kind -- of header the object has. This will be accounted for in the -- offsets of the fields returned. @@ -512,6 +518,25 @@ mkVirtHeapOffsetsWithPadding profile header things = , field_off ] +-- | Flatten a list of @'FieldOffOrPadding' StgArg@ into a list of @NonVoid StgArg@ +-- by decompose padding into zero-valued 'StgLitArgs' units of length 8, 4, 2, or 1 bytes. +litsWithPaddingToLits :: [FieldOffOrPadding StgArg] -> [NonVoid StgArg] +litsWithPaddingToLits = concatMap $ \case + FieldOff (NonVoid arg) _ -> [NonVoid arg] + Padding size _ -> map (NonVoid . StgLitArg) (zeroBytes size) + where + -- Make literals of value 0 for a total of n bytes of padding. + zeroBytes :: ByteOff -> [Literal] + zeroBytes n + | n == 0 = [] + | n == 1 = [LitNumber LitNumWord8 0] + | n == 2 = [LitNumber LitNumWord16 0] + | n == 4 = [LitNumber LitNumWord32 0] + | n == 8 = [LitNumber LitNumWord64 0] + | testBit n 0 = LitNumber LitNumWord8 0 : zeroBytes (n-1) + | testBit n 1 = LitNumber LitNumWord16 0 : zeroBytes (n-2) + | testBit n 2 = LitNumber LitNumWord32 0 : zeroBytes (n-4) + | otherwise = LitNumber LitNumWord64 0 : zeroBytes (n-8) mkVirtHeapOffsets :: Profile ===================================== libraries/ghci/GHCi/CreateBCO.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Exts hiding ( BCO, mkApUpd0#, newBCO# ) import GHC.Internal.Prim ( BCO, mkApUpd0#, newBCO# ) import GHC.IO import Control.Exception ( ErrorCall(..) ) +import Control.Monad {- Note [Tying the knot in createBCOs] @@ -198,7 +199,7 @@ createUnliftedStaticCons objs lif_arr = do getUnlDeps :: ResolvedBCO -> [Int] getUnlDeps (ResolvedStaticCon{..}) = - [ k | ptr <- ssElts resolvedStaticConPtrs + [ k | ptr <- smallArrayToList resolvedStaticConPtrs , ResolvedUnliftedStaticConRef k <- [ptr] ] getUnlDeps _ = [] @@ -219,24 +220,22 @@ linkBCO' arr unl_arr resolved_obj = bitmap_barr = barr (getBCOByteArray resolvedBCOBitmap) literals_barr = barr (getBCOByteArray resolvedBCOLits) - PtrsArr marr <- mkPtrsArray arr resolvedBCOPtrs + PtrsArr marr <- mkPtrsArray arr unl_arr resolvedBCOPtrs IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> - case newBCO insns_barr literals_barr arr arity# bitmap_barr of { IO io -> - io s + case newBCO# insns_barr literals_barr arr arity# bitmap_barr s of { (# s, bco #) -> + (# s, LinkedBCO resolvedBCOArity bco #) }} ResolvedStaticCon{..} -> do let - ptrs = ssElts resolvedStaticConPtrs - n_ptrs = sizeSS resolvedStaticConPtrs !(W# data_size#) = resolvedStaticConArity literals_barr = barr (getBCOByteArray resolvedStaticConLits) !(Ptr itbl_ptr#) = fromRemotePtr resolvedStaticConInfoPtr - PtrsArr marr <- mkPtrsArray arr unl_arr n_ptrs ptrs + PtrsArr marr <- mkPtrsArray arr unl_arr resolvedStaticConPtrs IO $ \s -> case unsafeFreezeArray# marr s of { (# s, arr #) -> @@ -384,4 +383,3 @@ emptyArr = unsafeDupablePerformIO $ IO $ \s -> (# s, EmptyArr farr #) }} - ===================================== libraries/ghci/GHCi/ResolvedBCO.hs ===================================== @@ -65,9 +65,20 @@ data ResolvedBCO resolvedBCOIsLE :: !Bool, resolvedStaticConInfoPtr :: !(RemotePtr Heap.StgInfoTable), resolvedStaticConArity :: {-# UNPACK #-} !Word, - resolvedStaticConLits :: BCOByteArray Word, - resolvedStaticConPtrs :: SizedSeq ResolvedBCOPtr, - resolvedStaticConIsUnlifted :: Bool + -- ^ how many words are used for the payload of the static constructor + -- (size of ptrs and (packed) non-ptrs combined) + resolvedStaticConLits :: !(BCOByteArray Word), + -- ^ Notably, sub-word non-ptr arguments and padding have already been + -- packed into full words, and this array only stores the full final + -- words to write as the constructor payload. + -- + -- This is opposed to what we do for BCO literals, where we keep + -- sub-word literals as full words. For static constructors, the layout + -- must match exactly what the NCG also expects, so we must pack + -- sub-words accordingly for compatibility between interpreted and + -- compiled code. + resolvedStaticConPtrs :: !(SmallArray ResolvedBCOPtr), + resolvedStaticConIsUnlifted :: !Bool } deriving (Generic, Show) ===================================== testsuite/tests/codeGen/should_run/T25636c/T25636c.script ===================================== @@ -0,0 +1,28 @@ +:set -XMagicHash +import GHC.Exts +import GHC.Word +:{ +data A = A Word8# Word16# Word8# +a = A (wordToWord8# 1##) (wordToWord16# 258##) (wordToWord8# 3##) +unA :: A -> (Word8, Word16, Word8) +unA (A x y z) = (W8# x, W16# y, W8# z) + +data B = B Word16# Word8# Word8# +b = B (wordToWord16# 772##) (wordToWord8# 5##) (wordToWord8# 6##) +unB :: B -> (Word16, Word8, Word8) +unB (B x y z) = (W16# x, W8# y, W8# z) + +data C = C Word8# Word8# Word8# Word8# +c = C (wordToWord8# 7##) (wordToWord8# 8##) (wordToWord8# 9##) (wordToWord8# 10##) +unC :: C -> (Word8, Word8, Word8, Word8) +unC (C w x y z) = (W8# w, W8# x, W8# y, W8# z) + +data D = D Word32# Word8# Word16# Word8# +d = D (wordToWord32# 16909060##) (wordToWord8# 11##) (wordToWord16# 3086##) (wordToWord8# 13##) +unD :: D -> (Word32, Word8, Word16, Word8) +unD (D w x y z) = (W32# w, W8# x, W16# y, W8# z) +:} +print (unA a) +print (unB b) +print (unC c) +print (unD d) ===================================== testsuite/tests/codeGen/should_run/T25636c/T25636c.stdout ===================================== @@ -0,0 +1,4 @@ +(1,258,3) +(772,5,6) +(7,8,9,10) +(16909060,11,3086,13) ===================================== testsuite/tests/codeGen/should_run/T25636c/all.T ===================================== @@ -0,0 +1 @@ +test('T25636c', [], ghci_script, ['T25636c.script']) ===================================== testsuite/tests/codeGen/should_run/T25636d/T25636d.script ===================================== @@ -0,0 +1,28 @@ +:set -XMagicHash +import GHC.Exts +import GHC.Int +:{ +data E = E Int8# Int16# Int8# +e = E (intToInt8# (-1#)) (intToInt16# (-258#)) (intToInt8# 3#) +unE :: E -> (Int8, Int16, Int8) +unE (E x y z) = (I8# x, I16# y, I8# z) + +data F = F Int16# Int8# Int8# +f = F (intToInt16# (-1025#)) (intToInt8# 6#) (intToInt8# (-7#)) +unF :: F -> (Int16, Int8, Int8) +unF (F x y z) = (I16# x, I8# y, I8# z) + +data G = G Int8# Int8# Int8# Int8# +g = G (intToInt8# (-8#)) (intToInt8# 9#) (intToInt8# (-10#)) (intToInt8# 11#) +unG :: G -> (Int8, Int8, Int8, Int8) +unG (G w x y z) = (I8# w, I8# x, I8# y, I8# z) + +data H = H Int32# Int8# Int16# Int8# +h = H (intToInt32# (-16909060#)) (intToInt8# 12#) (intToInt16# (-3342#)) (intToInt8# 14#) +unH :: H -> (Int32, Int8, Int16, Int8) +unH (H w x y z) = (I32# w, I8# x, I16# y, I8# z) +:} +print (unE e) +print (unF f) +print (unG g) +print (unH h) ===================================== testsuite/tests/codeGen/should_run/T25636d/T25636d.stdout ===================================== @@ -0,0 +1,4 @@ +(-1,-258,3) +(-1025,6,-7) +(-8,9,-10,11) +(-16909060,12,-3342,14) ===================================== testsuite/tests/codeGen/should_run/T25636d/all.T ===================================== @@ -0,0 +1 @@ +test('T25636d', [], ghci_script, ['T25636d.script']) ===================================== testsuite/tests/codeGen/should_run/T25636e/T25636e.script ===================================== @@ -0,0 +1,16 @@ +:set -XMagicHash +import GHC.Exts +import GHC.Word +:{ +data J = J Char# Word16# Word8# Word8# +j = J 'A'# (wordToWord16# 258##) (wordToWord8# 3##) (wordToWord8# 4##) +unJ :: J -> (Char, Word16, Word8, Word8) +unJ (J a b c d) = (C# a, W16# b, W8# c, W8# d) + +data K = K Word16# Char# Word8# Char# +k = K (wordToWord16# 1286##) 'B'# (wordToWord8# 7##) 'C'# +unK :: K -> (Word16, Char, Word8, Char) +unK (K a b c d) = (W16# a, C# b, W8# c, C# d) +:} +print (unJ j) +print (unK k) ===================================== testsuite/tests/codeGen/should_run/T25636e/T25636e.stdout ===================================== @@ -0,0 +1,2 @@ +('A',258,3,4) +(1286,'B',7,'C') ===================================== testsuite/tests/codeGen/should_run/T25636e/all.T ===================================== @@ -0,0 +1 @@ +test('T25636e', [], ghci_script, ['T25636e.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81cbdb13a30f56fe2503ee87327895… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81cbdb13a30f56fe2503ee87327895… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/correctly_propagate_host-build-target] Deleted 2 commits: bindist: Propagate user set $LD to ghc-toolchain
by Sven Tennie (＠supersven) 30 Mar '26

30 Mar '26

Sven Tennie pushed to branch wip/supersven/correctly_propagate_host-build-target at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: a0c6c7f7 by Sven Tennie at 2026-03-28T06:41:04+00:00 bindist: Propagate user set $LD to ghc-toolchain Otherwise, ghc-toolchain wrongly emits `-fuse-ld` for cross-compilers. - - - - - 0ff88825 by Sven Tennie at 2026-03-28T07:47:47+01:00 Respect user set CFLAGS, CXXFLAGS, LDFLAGS, etc. These were ignored on installs. - - - - - 1 changed file: - distrib/configure.ac.in Changes: ===================================== distrib/configure.ac.in ===================================== @@ -24,6 +24,10 @@ dnl works as expected, since we're slightly modifying how Autoconf dnl interprets build/host/target and how this interacts with $CC tests test -n "$target_alias" && ac_tool_prefix=$target_alias- +# Propagate $LD (if exists) to ghc-toolchain. Otherwise, ghc-toolchain tends to +# emit `-fuse-ld` for cross-compilers. +USER_LD="$LD" + dnl Various things from the source distribution configure bootstrap_build=@BuildPlatform@ bootstrap_host=@HostPlatform@ @@ -149,12 +153,38 @@ AC_SUBST([EnableStrictGhcToolchainCheck]) dnl ** Which gcc to use? dnl -------------------------------------------------------------- + +dnl AC_PROG_CC sets CFLAGS to `-g -O2` if the env var is empty. +dnl Same goes for AC_PROG_CXX and CXXFLAGS. Setting the vars prevents this. +dnl (`-g` increases binary sizes with debugging symbols. `-O2` may optimize +dnl symbols away, confusing the RTS linker.) +: ${CFLAGS=""} +: ${CXXFLAGS=""} + AC_PROG_CC([cc gcc clang]) AC_PROG_CXX([c++ g++ clang++]) # Work around #24324 MOVE_TO_FLAGS([CC],[CFLAGS]) MOVE_TO_FLAGS([CXX],[CXXFLAGS]) +dnl Save the original user-provided environment variables immediately +dnl before any m4 macros modify them. These will be passed to ghc-toolchain +dnl so it can make independent decisions and reach the same conclusions as autoconf. +USER_CONF_CC_OPTS_STAGE2="$CFLAGS" +USER_CONF_CXX_OPTS_STAGE2="$CXXFLAGS" +USER_CONF_GCC_LINKER_OPTS_STAGE2="$LDFLAGS" +USER_CPP_ARGS="$CPPFLAGS" +USER_HS_CPP_ARGS="$HaskellCPPArgs" +USER_JS_CPP_ARGS="$JavaScriptCPPArgs" +USER_CMM_CPP_ARGS="$CmmCPPArgs" + +dnl Initialize CONF_* variables with user-provided environment variables +dnl so that subsequent configure checks modify them and both autoconf and +dnl ghc-toolchain see the same values +CONF_CC_OPTS_STAGE2="$CFLAGS" +CONF_CXX_OPTS_STAGE2="$CXXFLAGS" +CONF_GCC_LINKER_OPTS_STAGE2="$LDFLAGS" + dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/136d30c62cc80e7e5f738dd93af805… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/136d30c62cc80e7e5f738dd93af805… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/25636] 5 commits: Allocate static constructors for bytecode
by Rodrigo Mesquita (＠alt-romes) 30 Mar '26

30 Mar '26

Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC Commits: 7e07decb by Rodrigo Mesquita at 2026-03-30T17:28:47+01:00 Allocate static constructors for bytecode This commit adds support for static constructors when compiling and linking ByteCode objects. Top-level StgRhsCon get lowered to ProtoStaticCons rather than to ProtoBCOs. A ProtoStaticCon gets allocated directly as a data con application on the heap (using the new primop newConApp#). Previously, we would allocate a ProtoBCO which, when evaluated, would PACK and return the constructor. A few more details are given in Note [Static constructors in Bytecode]. Secondly, this commit also fixes issue #25636 which was caused by linking *unlifted* constructors in BCO instructions as - (1) a thunk indexing the array of BCOs in a module - (2) which evaluated to a BCO which still had to be evaluated to return the unlifted constructor proper. The (2) issue has been resolved by allocating the static constructors directly. The (1) issue can be resolved by ensuring that we allocate all unlifted top-level constructors eagerly, and leave the knot-tying for the lifted BCOs and top-level constructors only. The top-level unlifted constructors are never mutually recursive, so we can allocate them all in one go as long as we do it in topological order. Lifted fields of unlifted constructors can still be filled by the knot-tied lifted variables since in those fields it is fine to keep those thunks. See Note [Tying the knot in createBCOs] for more details. Fixes #25636 - - - - - f5799a2e by Rodrigo Mesquita at 2026-03-30T17:28:47+01:00 Revert "StgToByteCode: Assert that PUSH_G'd values are lifted" This reverts commit ec26c54d818e0cd328276196930313f66b780905. Ever since f7a22c0f4e9ae0dc767115d4c53fddbd8372b777, we now do support and will link top-level unlifted constructors into evaluated and properly tagged values which we can reference with PUSH_G. This assertion is no longer true and triggered a failure in T25636 - - - - - be0ad37a by Rodrigo Mesquita at 2026-03-30T17:28:48+01:00 refactor: Tag more remote Ptrs as RemotePtr Pure refactor which improves the API of - GHC.ByteCode.Linker - GHC.Runtime.Interpreter - GHC.Runtime.Interpreter.Types.SymbolCache by using `RemotePtr` for more functions which used to return `Ptr`s that could potentially be in a foreign process. E.g. `lookupIE`, `lookupStaticPtr`, etc... - - - - - d219b11d by Rodrigo Mesquita at 2026-03-30T17:28:48+01:00 Add float# and subword tests for #25636 These tests cover that static constructors in bytecode work correctly for Float# and subword values (Word8#, Word16#) - - - - - 81cbdb13 by Rodrigo Mesquita at 2026-03-30T17:28:49+01:00 wip: start fixing, but manually packing things is kind of awful. how to do better? [skip ci] Just rebased. - - - - - 40 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Runtime/Interpreter/Types/SymbolCache.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Layout.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/ghci/GHCi/CreateBCO.hs - libraries/ghci/GHCi/ResolvedBCO.hs - rts/Interpreter.c - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/include/Rts.h - rts/include/rts/storage/ClosureMacros.h - rts/include/stg/MiscClosures.h - + testsuite/tests/codeGen/should_run/T23146/T25636.stdout - + testsuite/tests/codeGen/should_run/T25636a/T25636a.script - + testsuite/tests/codeGen/should_run/T25636a/T25636a.stdout - + testsuite/tests/codeGen/should_run/T25636a/all.T - + testsuite/tests/codeGen/should_run/T25636b/T25636b.script - + testsuite/tests/codeGen/should_run/T25636b/T25636b.stdout - + testsuite/tests/codeGen/should_run/T25636b/all.T - testsuite/tests/ghci.debugger/scripts/print034.stdout - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - utils/deriveConstants/Main.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e894b562dac549c40eff5e476a388… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e894b562dac549c40eff5e476a388… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/supersven/correctly_propagate_host-build-target_SAVE_2_COMMITS
by Sven Tennie (＠supersven) 30 Mar '26

30 Mar '26

Sven Tennie pushed new branch wip/supersven/correctly_propagate_host-build-target_SAVE_2_COMMITS at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/correctly_propagate… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ani/no-ds-flag-cache] Wibbles from Simon
by Simon Peyton Jones (＠simonpj) 30 Mar '26

30 Mar '26

Simon Peyton Jones pushed to branch wip/ani/no-ds-flag-cache at Glasgow Haskell Compiler / GHC Commits: 6986cae3 by Simon Peyton Jones at 2026-03-30T17:05:10+01:00 Wibbles from Simon - - - - - 7 changed files: - compiler/GHC/Tc/Gen/App.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/Utils/TcMType.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -488,8 +488,8 @@ checkResultTy :: HsExpr GhcRn -- expose foralls, but maybe not /deeply/ instantiated -> ExpRhoType -- Expected type; this is deeply skolemised -> TcM HsWrapper -checkResultTy rn_expr (tc_fun, _) _ app_res_rho (Infer inf_res) - = do { ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun +checkResultTy rn_expr _ _ app_res_rho (Infer inf_res) + = do { ds_flag <- getDeepSubsumptionFlag ; fillInferResult ds_flag (exprCtOrigin rn_expr) app_res_rho inf_res } @@ -636,7 +636,8 @@ tcValArg _ pos (fun, fun_lspan) (EValArgQL { , text "app_lspan" <+> ppr lspan , text "head_lspan" <+> ppr fun_lspan , text "tc_head" <+> ppr tc_head]) - ; ds_flag <- getDeepSubsumptionFlag_DataConHead (fst tc_head) + ; ds_flag <- getDeepSubsumptionFlag + -- NB: whether to do deep /skolemisation/ is independent of data constructors ; (wrap, arg') <- tcScalingUsage mult $ tcSkolemise ds_flag GenSigCtxt exp_arg_ty $ \ exp_arg_rho -> @@ -894,8 +895,7 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg matchActualFunTy herald (Just $ HsExprTcThing tc_fun) (n_val_args, fun_sigma) fun_ty - ; ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun - ; arg' <- quickLookArg ds_flag do_ql pos ctxt (rn_fun, fun_lspan) arg arg_ty + ; arg' <- quickLookArg do_ql pos ctxt (rn_fun, fun_lspan) arg arg_ty ; let acc' = arg' : addArgWrap (mkWpCastN fun_co) acc ; go (pos+1) acc' res_ty rest_args } @@ -1883,17 +1883,18 @@ This turned out to be more subtle than I expected. Wrinkles: -} -quickLookArg :: DeepSubsumptionFlag -> QLFlag -> Int +quickLookArg :: QLFlag -> Int -> SrcSpan -- ^ location span of the whole application -> (HsExpr GhcRn, SrcSpan) -- ^ Head of the application chain and its source span -> LHsExpr GhcRn -- ^ Argument -> Scaled TcSigmaTypeFRR -- ^ Type expected by the function -> TcM (HsExprArg 'TcpInst) -- See Note [Quick Look at value arguments] -quickLookArg _ NoQL _ app_lspan _ larg orig_arg_ty +quickLookArg NoQL _ app_lspan _ larg orig_arg_ty = skipQuickLook app_lspan larg orig_arg_ty -quickLookArg ds_flag DoQL pos app_lspan fun_and_lspan larg orig_arg_ty - = do { is_rho <- tcIsDeepRho ds_flag (scaledThing orig_arg_ty) +quickLookArg DoQL pos app_lspan fun_and_lspan larg orig_arg_ty + = do { ds_flag <- getDeepSubsumptionFlag + ; is_rho <- tcIsDeepRho ds_flag (scaledThing orig_arg_ty) ; traceTc "qla" (ppr orig_arg_ty $$ ppr is_rho) ; if not is_rho then skipQuickLook app_lspan larg orig_arg_ty ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Tc.Gen.Expr ( tcCheckPolyExpr, tcCheckPolyExprNC, tcCheckMonoExpr, tcCheckMonoExprNC, - tcInferExpr, tcInferSigma, + tcInferExpr, tcInferSigma, tcInferExprSigma, tcInferRho, tcInferRhoNC, tcMonoLExpr, tcMonoLExprNC, tcInferRhoFRR, tcInferRhoFRRNC, @@ -237,6 +237,9 @@ tcPolyExprCheck expr res_ty tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcSigmaType) tcInferSigma = tcInferExpr IIF_Sigma +tcInferExprSigma :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) +tcInferExprSigma e = runInfer IIF_Sigma IFRR_Any (tcExpr e) + tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType) -- Infer a *rho*-type. The return type is always instantiated. tcInferRho = tcInferExpr IIF_DeepRho @@ -321,7 +324,7 @@ tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr (XExpr (ExpandedThingRn hse)) res_ty = tcHsExpansion hse res_ty -tcExpr e@(XExpr{}) res_ty = tcApp e res_ty +tcExpr e@(XExpr (HsRecSelRn {})) res_ty = tcApp e res_ty -- Typecheck an occurrence of an unbound Id -- @@ -527,8 +530,9 @@ tcExpr (HsCase ctxt scrut matches) res_ty tcExpr (HsIf x pred b1 b2) res_ty = do { pred' <- tcCheckMonoExpr pred boolTy - ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty - ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty + ; let res_ty' = adjustExpTypeForCaseBranches res_ty [b1,b2] + ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty' + ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty' ; tcEmitBindingUsage (supUE u1 u2) ; return (HsIf x pred' b1' b2') } ===================================== compiler/GHC/Tc/Gen/Expr.hs-boot ===================================== @@ -35,6 +35,8 @@ tcInferRho, tcInferRhoNC :: tcInferRhoFRR, tcInferRhoFRRNC :: FixedRuntimeRepContext -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType) +tcInferExprSigma :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType) + tcInferExpr :: InferInstFlag -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType) tcSyntaxOp :: CtOrigin ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -21,15 +21,14 @@ module GHC.Tc.Gen.Head , pprArgInst, addFunResCtxt ) where -import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckPolyExprNC, tcPolyLExprSig ) +import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckPolyExprNC, tcPolyLExprSig, tcInferExprSigma ) import {-# SOURCE #-} GHC.Tc.Gen.Splice( getUntypedSpliceBody ) -import {-# SOURCE #-} GHC.Tc.Gen.App( tcExprSigma ) import GHC.Prelude import GHC.Hs import GHC.Hs.Syn.Type -import GHC.Rename.Utils (mkExpandedTc, mkExpandedExprTc) +import GHC.Rename.Utils (mkExpandedExprTc) import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Bind( chooseInferredQuantifiers ) @@ -446,7 +445,7 @@ tcInferAppHead (fun,fun_lspan) do { mb_tc_fun <- tcInferAppHead_maybe fun ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) - Nothing -> runInferRho (tcExpr fun) + Nothing -> tcInferExprSigma fun } @@ -465,13 +464,14 @@ tcInferAppHead_maybe fun = case fun of -> Just <$> tcInferOverLit lit XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f - XExpr (ExpandedThingRn (HSE o (L loc e))) - -> setSrcSpan (locA loc) $ Just <$> - do { (e', ty) <- tcExprSigma False (hsCtxtCtOrigin o) e - ; return (mkExpandedTc o (L loc e'), ty) } - -- We do not want to instantiate the type of the head as there may be - -- visible type applications in the argument. - -- c.f. T19167 + +-- XExpr (ExpandedThingRn (HSE o (L loc e))) +-- -> setSrcSpan (locA loc) $ Just <$> +-- do { (e', ty) <- tcExprSigma False (hsCtxtCtOrigin o) e +-- ; return (mkExpandedTc o (L loc e'), ty) } +-- -- We do not want to instantiate the type of the head as there may be +-- -- visible type applications in the argument. +-- -- c.f. T19167 _ -> return Nothing ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -219,10 +219,10 @@ tcMatches :: (AnnoBody body, Outputable (body GhcTc)) -> MatchGroup GhcRn (LocatedA (body GhcRn)) -> TcM (MatchGroup GhcTc (LocatedA (body GhcTc))) -tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches +tcMatches ctxt tc_body pat_tys exp_ty (MG { mg_alts = L l matches , mg_ext = origin }) | null matches -- Deal with case e of {} - -- Since there are no branches, no one else will fill in rhs_ty + -- Since there are no branches, no one else will fill in exp_ty -- when in inference mode, so we must do it ourselves, -- here, using expTypeToType = do { tcEmitBindingUsage bottomUE @@ -233,17 +233,19 @@ tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches [ExpForAllPatTy tvb] -> failWithTc $ TcRnEmptyCase ctxt (EmptyCaseForall tvb) [] -> panic "tcMatches: no arguments in EmptyCase" _t1:(_t2:_ts) -> panic "tcMatches: multiple arguments in EmptyCase" - ; rhs_ty <- expTypeToType rhs_ty + ; rhs_ty <- expTypeToType exp_ty ; return (MG { mg_alts = L l [] , mg_ext = MatchGroupTc [pat_ty] rhs_ty origin }) } | otherwise - = do { umatches <- mapM (tcCollectingUsage . tcMatch tc_body pat_tys rhs_ty) matches - ; let (usages, matches') = unzip umatches + = do { let exp_ty' = adjustExpTypeForCaseBranches exp_ty matches + tc_match match = tcCollectingUsage $ + tcMatch tc_body pat_tys exp_ty' match + ; (usages, matches') <- mapAndUnzipM tc_match matches ; tcEmitBindingUsage $ supUEs usages ; pat_tys <- mapM readScaledExpType (filter_out_forall_pat_tys pat_tys) - ; rhs_ty <- readExpType rhs_ty + ; rhs_ty <- readExpType exp_ty ; traceTc "tcMatches" (ppr matches' $$ ppr pat_tys $$ ppr rhs_ty) ; return (MG { mg_alts = L l matches' , mg_ext = MatchGroupTc pat_tys rhs_ty origin ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -63,7 +63,7 @@ module GHC.Tc.Utils.TcMType ( mkCheckExpType, newInferExpType, newInferExpTypeFRR, runInfer, runInferRho, runInferSigma, runInferKind, runInferRhoFRR, runInferSigmaFRR, readExpType, readExpType_maybe, readScaledExpType, - expTypeToType, scaledExpTypeToType, + expTypeToType, scaledExpTypeToType, adjustExpTypeForCaseBranches, checkingExpType_maybe, checkingExpType, inferResultToType, ensureMonoType, promoteTcType, @@ -499,6 +499,17 @@ inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl ; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr ; return tau } +adjustExpTypeForCaseBranches :: ExpRhoType -> [branch] -> ExpRhoType +-- See Note [fillInferResult: multiple branches] +adjustExpTypeForCaseBranches exp_ty branches + = case exp_ty of + Infer ir | IR { ir_inst = IIF_Sigma } <- ir + , branches `lengthAtLeast` 2 + -> Infer (ir { ir_inst = IIF_DeepRho }) + | otherwise + -> exp_ty + Check {} -> exp_ty + {- Note [inferResultToType] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ expTypeToType and inferResultType convert an InferResult to a monotype. ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -426,7 +426,7 @@ Some examples: tcSkolemiseGeneral :: HasDebugCallStack - => DeepSubsumptionFlag + => DeepSubsumptionFlag -- Ignores the DeepSubsumptionDepth -> UserTypeCtxt -> TcType -> TcType -- top_ty and expected_ty -- Here, top_ty is the type we started to skolemise; used only in SigSkol @@ -1169,7 +1169,7 @@ fillInferResultNoInst act_res_ty (IR { ir_uniq = u ; return final_co } } -fillInferResult :: DeepSubsumptionFlag -> CtOrigin -> TcType -> InferResult -> TcM HsWrapper +fillInferResult :: DeepSubsumptionFlag -> CtOrigin -> TcSigmaType -> InferResult -> TcM HsWrapper -- See Note [Instantiation of InferResult] fillInferResult ds_flag ct_orig res_ty ires@(IR { ir_inst = iif }) = case iif of @@ -1203,7 +1203,7 @@ There are two things to worry about: T1 -> e1 T2 -> e2 -Our typing rules are: +In general our typing rules are: * The RHS of a existential or GADT alternative must always be a monotype, regardless of the number of alternatives. @@ -1218,17 +1218,13 @@ Our typing rules are: We use choice (2) in that Section. (GHC 8.10 and earlier used choice (1).) - But note that - case e of - True -> hr - False -> \x -> hr x - will fail, because we still /infer/ both branches, so the \x will get - a (monotype) unification variable, which will fail to unify with - (forall a. a->a) +Note [fillInferResult: GADTs and existentials] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We can detect the GADT/existential situation, case (1) of Note [fillInferResult], +by seeing that the current TcLevel is greater than that stored in ir_lvl of the +Infer ExpType. We bump the level whenever we go past a GADT/existential match. -For (1) we can detect the GADT/existential situation by seeing that -the current TcLevel is greater than that stored in ir_lvl of the Infer -ExpType. We bump the level whenever we go past a GADT/existential match. +We insist that the RHS has a monotype, regardless of the number of alternatives. Then, before filling the hole use promoteTcType to promote the type to the outer ir_lvl. promoteTcType does this @@ -1239,11 +1235,6 @@ That forces the type to be a monotype (since unification variables can only unify with monotypes); and catches skolem-escapes because the alpha is untouchable until the equality floats out. -For (2), we simply look to see if the hole is filled already. - - if not, we promote (as above) and fill the hole - - if it is filled, we simply unify with the type that is - already there - (FIR1) There is one wrinkle. Suppose we have case e of T1 -> e1 :: (forall a. a->a) -> Int @@ -1258,7 +1249,36 @@ For (2), we simply look to see if the hole is filled already. So if we check G2 second, we still want to emit a constraint that restricts the RHS to be a monotype. This is done by ensureMonoType, and it works by simply generating a constraint (alpha ~ ty), where alpha is a fresh -unification variable. We discard the evidence. + unification variable. We discard the evidence. + +Note [fillInferResult: multiple branches] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If there are multiple case branches, case (2) of Note [fillInferResult] +we simply look to see if the hole is filled already. + - if not, we promote (as above) and fill the hole + - if it is filled, we simply unify with the type that is already there + +But consider + case x of + True -> True + False -> error "urk" +and suppose we call `tcInferSigma` on this expression, so that the `ir_inst` +field of the expected result type is `IIF_Sigma`. The danger is that we'll +fill the hole with `Bool` (from the `True`) and then reject when we try to +unify that with `forall a. a->a`, from the call to `error`. + +To avoid this, we never infer a sigma-type from a multi-branch `case`. Instead +we just zap the `IIF_Sigma` to `IIF_DeepRho` when walking inside the branches +of multi-arm case-expression, or an if-expression. See calls to +`adjustExpTypeForCaseBranches`. + +Note that + case e of + True -> hr + False -> \x -> hr x + where hr :: (forall a. a->a) -> Int +will fail, because we still /infer/ both branches, so the \x will get a +(monotype) unification variable, which will fail to unify with (forall a. a->a) Note [Instantiation of InferResult] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2068,17 +2088,20 @@ getDeepSubsumptionFlag = -- | Variant of 'getDeepSubsumptionFlag' which enables a top-level subsumption -- in order to implement the plan of Note [Typechecking data constructors]. getDeepSubsumptionFlag_DataConHead :: HsExpr GhcTc -> TcM DeepSubsumptionFlag -getDeepSubsumptionFlag_DataConHead app_head = - do { user_ds <- xoptM LangExt.DeepSubsumption - ; traceTc "getDeepSubsumptionFlag_DataConHead" (ppr app_head) - ; return $ - if | user_ds - -> Deep DeepSub - | XExpr (ConLikeTc (RealDataCon {})) <- app_head - -> Deep TopSub - | otherwise - -> Shallow - } +getDeepSubsumptionFlag_DataConHead app_head + = do { user_ds <- xoptM LangExt.DeepSubsumption + ; return $ if | user_ds -> Deep DeepSub + | dc_head app_head -> Deep TopSub + | otherwise -> Shallow } + where + dc_head (XExpr (ConLikeTc (RealDataCon {}))) = True + dc_head (XExpr (WrapExpr _ f)) = dc_head f + dc_head (HsApp _ (L _ f) _) = dc_head f + dc_head (HsAppType _ (L _ f) _) = dc_head f + dc_head (OpApp _ _ (L _ f) _) = dc_head f + dc_head (HsPar _ (L _ f)) = dc_head f + dc_head _ = False + -- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6986cae3bb35153090fa566d1f88043… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6986cae3bb35153090fa566d1f88043… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sjakobi/T27115] Various notation fixes regarding demand signatures
by Simon Jakobi (＠sjakobi2) 30 Mar '26

30 Mar '26

Simon Jakobi pushed to branch wip/sjakobi/T27115 at Glasgow Haskell Compiler / GHC Commits: 4a34ff4e by Simon Jakobi at 2026-03-30T17:35:17+02:00 Various notation fixes regarding demand signatures [skip ci] - - - - - 3 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Types/Demand.hs - docs/users_guide/using-optimisation.rst Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1443,7 +1443,7 @@ because it has seen two lambdas, \x and \y. Since the length of the argument demands in a DmdSig gives the "threshold" for applying the signature (see Note [DmdSig: demand signatures, and demand-sig arity] in GHC.Types.Demand) we must trim that DmdType to just - DmdSig (DmdTypte fvs [x-dmd]) + DmdSig (DmdType fvs [x-dmd]) when making that DmdType into the DmdSig for f. This trimming is the job of `mkDmdSigForArity`. ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -510,7 +510,7 @@ type CardNonOnce = Card -- | Absent, {0}. Pretty-printed as A. pattern C_00 :: Card pattern C_00 = Card 0b001 --- | Bottom, {}. Pretty-printed as A. +-- | Bottom, {}. Pretty-printed as B. pattern C_10 :: Card pattern C_10 = Card 0b000 -- | Strict and used once, {1}. Pretty-printed as 1. @@ -2046,7 +2046,7 @@ gets reached. For example, we don't want to be strict in the strict free variables of 'rhs'. So we have the simple definition - deferAfterPreciseException = lubDmdType (DmdType emptyDmdEnv [] exnDiv) + deferAfterPreciseException = lubDmdType (DmdType (DE emptyVarEnv exnDiv) []) Historically, when we had `lubBoxity = _unboxedWins` (see Note [unboxedWins]), we had a more complicated definition for deferAfterPreciseException to make sure @@ -2054,7 +2054,7 @@ it preserved boxity in its argument. That was needed for code like case <I/O operation> of (# s', r) -> f x -which uses `x` *boxed*. If we `lub`bed it with `(DmdType emptyDmdEnv [] exnDiv)` +which uses `x` *boxed*. If we `lub`bed it with `(DmdType (DE emptyVarEnv exnDiv) [])` we'd get an *unboxed* demand on `x` (because we let Unboxed win), which led to #20746. Nowadays with `lubBoxity = boxedWins` we don't need the complicated definition. @@ -2191,8 +2191,8 @@ transformer, namely a single DmdType (Nevertheless we dignify DmdSig as a distinct type.) -The DmdSig for an Id is a semantic thing. Suppose a function `f` has a DmdSig of - DmdSig (DmdType (fv_dmds,res) [d1..dn]) +The DmdSig for an Id is a semantic thing. Suppose a function `f` has a DmdSig of + DmdSig (DmdType (DmdEnv fv_dmds div) [d1..dn]) Here `n` is called the "demand-sig arity" of the DmdSig. The signature means: * If you apply `f` to n arguments (the demand-sig-arity) * then you can unleash demands d1..dn on the arguments @@ -2206,10 +2206,10 @@ demand, used for signature inference. Therefore we place a top demand on all arguments. For example, the demand transformer described by the demand signature - DmdSig (DmdType {x -> <1L>} <A><1P(L,L)>) + <A><1P(L,L)>{x->1L} says that when the function is applied to two arguments, it -unleashes demand 1L on the free var x, A on the first arg, -and 1P(L,L) on the second. +unleashes demand A on the first arg, 1P(L,L) on the second, +and 1L on the free var x. If this same function is applied to one arg, all we can say is that it uses x with 1L, and its arg with demand 1P(L,L). @@ -2229,10 +2229,10 @@ was evaluated. Here's an example: The abstract transformer (let's call it F_e) of the if expression (let's call it e) would transform an incoming (undersaturated!) head sub-demand A -into a demand type like {x-><1L>,y-><L>}<L>. In pictures: +into a demand type like <L>{x->1L,y->L}. In pictures: SubDemand ---F_e---> DmdType - <A> {x-><1L>,y-><L>}<L> + <A> <L>{x->1L,y->L} Let's assume that the demand transformers we compute for an expression are correct wrt. to some concrete semantics for Core. How do demand signatures fit @@ -2240,7 +2240,7 @@ in? They are strange beasts, given that they come with strict rules when to it's sound to unleash them. Fortunately, we can formalise the rules with Galois connections. Consider -f's strictness signature, {}<1L><L>. It's a single-point approximation of +f's strictness signature, <1L><L>. It's a single-point approximation of the actual abstract transformer of f's RHS for arity 2. So, what happens is that we abstract *once more* from the abstract domain we already are in, replacing the incoming Demand by a simple lattice with two elements denoting incoming @@ -2260,8 +2260,8 @@ With and F_f being the abstract transformer of f's RHS and f_f being the abstracted abstract transformer computable from our demand signature simply by - f_f(>=2) = {}<1L><L> - f_f(<2) = multDmdType C_0N {}<1L><L> + f_f(>=2) = <1L><L> + f_f(<2) = multDmdType C_0N <1L><L> where multDmdType makes a proper top element out of the given demand type. @@ -2283,9 +2283,9 @@ yields a more precise demand type: incoming sub-demand | demand type -------------------------------- - P(A) | <L><L>{} - C(1,C(1,P(L))) | <1P(L)><L>{} - C(1,C(1,1P(1P(L),A))) | <1P(A)><A>{} + P(A) | <L><L> + C(1,C(1,P(L))) | <1P(L)><L> + C(1,C(1,1P(1P(L),A))) | <1P(A)><A> Note that in the first example, the depth of the demand type was *higher* than the arity of the incoming call demand due to the anonymous lambda. ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1614,7 +1614,7 @@ as such you shouldn't need to set any of them explicitly. A flag a polymorphic sub-demand of the same letter: E.g. ``L`` is equivalent to ``LL`` by expansion of the single letter demand, which is equivalent to ``LP(LP(..))``, so ``L``\s all the way down. It is always clear from - context whether we talk about about a cardinality, sub-demand or demand. + context whether we talk about a cardinality, sub-demand or demand. **Demand signatures** @@ -1653,8 +1653,8 @@ as such you shouldn't need to set any of them explicitly. A flag maybe n _ Nothing = n maybe _ s (Just a) = s a - We give it demand signature ``<L><MC(M,L)><1L>``. The ``C(M,L)`` is a *call - sub-demand* that says "Called at most once, where the result is used + We give it demand signature ``<ML><MC(1,L)><1L>``. The ``C(1,L)`` is a *call + sub-demand* that says "Called exactly once, where the result is used according to ``L``". The expression ``f `seq` f 1`` puts ``f`` under demand ``SC(1,L)`` and serves as an example where the upper bound on evaluation cardinality doesn't coincide with that of the call cardinality. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a34ff4e938e1c7bde6bd1ccee0f62e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a34ff4e938e1c7bde6bd1ccee0f62e… You're receiving this email because of your account on gitlab.haskell.org.

1 0