Cheng Shao pushed to branch wip/ghci-no-simpl at Glasgow Haskell Compiler / GHC
Commits:
8f3d80ff by Luite Stegeman at 2025-09-13T08:43:09+02:00
Use mkVirtHeapOffsets for reconstructing terms in RTTI
This makes mkVirtHeapOffsets the single source of truth for
finding field offsets in closures.
- - - - -
eb389338 by Luite Stegeman at 2025-09-13T08:43:09+02:00
Sort non-pointer fields by size for more efficient packing
This sorts non-pointer fields in mkVirtHeapOffsets, always
storing the largest field first. The relative order of
equally sized fields remains unchanged.
This reduces wasted padding/alignment space in closures with
differently sized fields.
- - - - -
99b233f4 by Alison at 2025-09-13T16:51:04-04:00
ghc-heap: Fix race condition with profiling builds
Apply the same fix from Closures.hs (64fd0fac83) to Heap.hs by adding
empty imports to make way-dependent dependencies visible to `ghc -M`.
Fixes #15197, #26407
- - - - -
c892dd78 by Cheng Shao at 2025-09-14T09:19:25+02:00
genprimopcode: add hls support
This commit adds hie.yaml to genprimopcode so that one can use hls to
hack on it.
- - - - -
a9cd271d by Cheng Shao at 2025-09-14T09:19:25+02:00
genprimopcode: ensure seq is also included in PrimopWrappers.hs
This patch changes genprimopcode and ensure seq is also included in
PrimopWrappers.hs. This is needed when bytecode calls the seq primop.
Co-authored-by: Codex
- - - - -
9502796c by Cheng Shao at 2025-09-14T09:19:25+02:00
compiler: use simpleOptExpr instead of simplifyExpr in hscCompileCoreExpr
This commit makes hscCompileCoreExpr use simpleOptExpr instead of
simplifyExpr, so to make it faster by doing less work when compiling
TH splices to bytecode.
-------------------------
Metric Decrease:
MultiLayerModulesTH_OneShot
-------------------------
- - - - -
54ee4bca by Cheng Shao at 2025-09-14T09:19:25+02:00
compiler: remove unused simplifyExpr logic
- - - - -
14 changed files:
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/StgToCmm/Layout.hs
- libraries/ghc-heap/GHC/Exts/Heap.hs
- testsuite/tests/codeGen/should_run/T13825-unit.hs
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout
- testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout-ws-32
- utils/genprimopcode/Main.hs
- + utils/genprimopcode/hie.yaml
Changes:
=====================================
compiler/GHC/Core/Opt/Pipeline.hs
=====================================
@@ -6,7 +6,7 @@
{-# LANGUAGE CPP #-}
-module GHC.Core.Opt.Pipeline ( core2core, simplifyExpr ) where
+module GHC.Core.Opt.Pipeline ( core2core ) where
import GHC.Prelude
@@ -27,7 +27,7 @@ import GHC.Core.Ppr ( pprCoreBindings )
import GHC.Core.Utils ( dumpIdInfoOfProgram )
import GHC.Core.Lint ( lintAnnots )
import GHC.Core.Lint.Interactive ( interactiveInScope )
-import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm )
+import GHC.Core.Opt.Simplify ( simplifyPgm )
import GHC.Core.Opt.Simplify.Monad
import GHC.Core.Opt.Monad
import GHC.Core.Opt.Pipeline.Types
=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -1,8 +1,8 @@
{-# LANGUAGE CPP #-}
module GHC.Core.Opt.Simplify
- ( SimplifyExprOpts(..), SimplifyOpts(..)
- , simplifyExpr, simplifyPgm
+ ( SimplifyOpts(..)
+ , simplifyPgm
) where
import GHC.Prelude
@@ -11,20 +11,18 @@ import GHC.Driver.Flags
import GHC.Core
import GHC.Core.Rules
-import GHC.Core.Ppr ( pprCoreBindings, pprCoreExpr )
-import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
-import GHC.Core.Stats ( coreBindsSize, coreBindsStats, exprSize )
+import GHC.Core.Ppr ( pprCoreBindings )
+import GHC.Core.Opt.OccurAnal ( occurAnalysePgm )
+import GHC.Core.Stats ( coreBindsSize, coreBindsStats )
import GHC.Core.Utils ( mkTicks, stripTicksTop )
import GHC.Core.Lint ( LintPassResultConfig, dumpPassResult, lintPassResult )
-import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules )
+import GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplImpRules )
import GHC.Core.Opt.Simplify.Utils ( activeRule )
import GHC.Core.Opt.Simplify.Inline ( activeUnfolding )
import GHC.Core.Opt.Simplify.Env
import GHC.Core.Opt.Simplify.Monad
import GHC.Core.Opt.Stats ( simplCountN )
-import GHC.Core.FamInstEnv
-import GHC.Utils.Error ( withTiming )
import GHC.Utils.Logger as Logger
import GHC.Utils.Outputable
import GHC.Utils.Constants (debugIsOn)
@@ -44,72 +42,6 @@ import GHC.Types.Unique.FM
import Control.Monad
import Data.Foldable ( for_ )
-{-
-************************************************************************
-* *
- Gentle simplification
-* *
-************************************************************************
--}
-
--- | Configuration record for `simplifyExpr`.
--- The values of this datatype are /only/ driven by the demands of that function.
-data SimplifyExprOpts = SimplifyExprOpts
- { se_fam_inst :: ![FamInst]
- , se_mode :: !SimplMode
- , se_top_env_cfg :: !TopEnvConfig
- }
-
-simplifyExpr :: Logger
- -> ExternalUnitCache
- -> SimplifyExprOpts
- -> CoreExpr
- -> IO CoreExpr
--- ^ Simplify an expression using 'simplExprGently'.
---
--- See 'simplExprGently' for details.
-simplifyExpr logger euc opts expr
- = withTiming logger (text "Simplify [expr]") (const ()) $
- do { eps <- eucEPS euc ;
- ; let fam_envs = ( eps_fam_inst_env eps
- , extendFamInstEnvList emptyFamInstEnv $ se_fam_inst opts
- )
- simpl_env = mkSimplEnv (se_mode opts) fam_envs
- top_env_cfg = se_top_env_cfg opts
- read_eps_rules = eps_rule_base <$> eucEPS euc
- read_ruleenv = updExternalPackageRules emptyRuleEnv <$> read_eps_rules
-
- ; let sz = exprSize expr
-
- ; (expr', counts) <- initSmpl logger read_ruleenv top_env_cfg sz $
- simplExprGently simpl_env expr
-
- ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats
- "Simplifier statistics" FormatText (pprSimplCount counts)
-
- ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl "Simplified expression"
- FormatCore
- (pprCoreExpr expr')
-
- ; return expr'
- }
-
-simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
--- ^ Simplifies an expression by doing occurrence analysis, then simplification,
--- and repeating (twice currently), because one pass alone leaves tons of crud.
---
--- Used only:
---
--- 1. for user expressions typed in at the interactive prompt (see 'GHC.Driver.Main.hscStmt'),
--- 2. for Template Haskell splices (see 'GHC.Tc.Gen.Splice.runMeta').
---
--- The name 'Gently' suggests that the SimplMode is InitialPhase,
--- and in fact that is so.... but the 'Gently' in 'simplExprGently' doesn't
--- enforce that; it just simplifies the expression twice.
-simplExprGently env expr = do
- expr1 <- simplExpr env (occurAnalyseExpr expr)
- simplExpr env (occurAnalyseExpr expr1)
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
=====================================
@@ -1,6 +1,5 @@
module GHC.Driver.Config.Core.Opt.Simplify
- ( initSimplifyExprOpts
- , initSimplifyOpts
+ ( initSimplifyOpts
, initSimplMode
, initGentleSimplMode
) where
@@ -9,7 +8,7 @@ import GHC.Prelude
import GHC.Core.Rules ( RuleBase )
import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) )
-import GHC.Core.Opt.Simplify ( SimplifyExprOpts(..), SimplifyOpts(..) )
+import GHC.Core.Opt.Simplify ( SimplifyOpts(..) )
import GHC.Core.Opt.Simplify.Env ( FloatEnable(..), SimplMode(..), SimplPhase(..) )
import GHC.Core.Opt.Simplify.Monad ( TopEnvConfig(..) )
@@ -19,26 +18,9 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts )
import GHC.Driver.Config.Core.Opt.Arity ( initArityOpts )
import GHC.Driver.DynFlags ( DynFlags(..), GeneralFlag(..), gopt )
-import GHC.Runtime.Context ( InteractiveContext(..) )
-
import GHC.Types.Basic ( CompilerPhase(..) )
import GHC.Types.Var ( Var )
-initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts
-initSimplifyExprOpts dflags ic = SimplifyExprOpts
- { se_fam_inst = snd $ ic_instances ic
- , se_mode = (initSimplMode dflags InitialPhase "GHCi")
- { sm_inline = False
- -- Do not do any inlining, in case we expose some
- -- unboxed tuple stuff that confuses the bytecode
- -- interpreter
- }
- , se_top_env_cfg = TopEnvConfig
- { te_history_size = historySize dflags
- , te_tick_factor = simplTickFactor dflags
- }
- }
-
initSimplifyOpts :: DynFlags -> [Var] -> Int -> SimplMode -> RuleBase -> SimplifyOpts
initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let
-- This is a particularly ugly construction, but we will get rid of it in !8341.
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -121,8 +121,8 @@ import GHC.Driver.Errors
import GHC.Driver.Messager
import GHC.Driver.Errors.Types
import GHC.Driver.CodeOutput
+import GHC.Driver.Config
import GHC.Driver.Config.Cmm.Parser (initCmmParserConfig)
-import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts )
import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO )
import GHC.Driver.Config.Core.Lint.Interactive ( lintInteractiveExpr )
import GHC.Driver.Config.CoreToStg
@@ -181,6 +181,7 @@ import GHC.Core.Utils ( exprType )
import GHC.Core.ConLike
import GHC.Core.Opt.Pipeline
import GHC.Core.Opt.Pipeline.Types ( CoreToDo (..))
+import GHC.Core.SimpleOpt
import GHC.Core.TyCon
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
@@ -2712,15 +2713,17 @@ hscCompileCoreExpr hsc_env loc expr =
hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
hscCompileCoreExpr' hsc_env srcspan ds_expr = do
{- Simplify it -}
- -- Question: should we call SimpleOpt.simpleOptExpr here instead?
- -- It is, well, simpler, and does less inlining etc.
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
- let ic = hsc_IC hsc_env
- let unit_env = hsc_unit_env hsc_env
- let simplify_expr_opts = initSimplifyExprOpts dflags ic
- simpl_expr <- simplifyExpr logger (ue_eps unit_env) simplify_expr_opts ds_expr
+ let simpl_expr =
+ simpleOptExpr
+ ( initSimpleOpts $
+ if gopt Opt_UnoptimizedCoreForInterpreter dflags
+ then updOptLevel 0 dflags
+ else dflags
+ )
+ ds_expr
-- Create a unique temporary binding
--
=====================================
compiler/GHC/Runtime/Heap/Inspect.hs
=====================================
@@ -74,12 +74,12 @@ import GHC.Utils.Outputable as Ppr
import GHC.Utils.Panic
import GHC.Char
import GHC.Exts.Heap
-import GHC.Runtime.Heap.Layout ( roundUpTo )
+import GHC.Runtime.Heap.Layout (ByteOff)
import GHC.IO (throwIO)
import Control.Monad
import Data.Maybe
-import Data.List ((\\))
+import Data.List ((\\), mapAccumL)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import GHC.Exts
@@ -89,6 +89,10 @@ import Foreign hiding (shiftL, shiftR)
import System.IO.Unsafe
import GHC.InfoProv
+import GHC.StgToCmm.Closure ( NonVoid(NonVoid))
+import GHC.StgToCmm.Layout (mkVirtHeapOffsets, ClosureHeader(..))
+import Data.Array (Array, (!), array)
+
---------------------------------------------
-- * A representation of semi evaluated Terms
---------------------------------------------
@@ -922,63 +926,80 @@ extractSubTerms :: (Type -> ForeignHValue -> TcM Term)
-> [Word] -- ^ data arguments
-> [Type]
-> TcM [Term]
-extractSubTerms recurse ptr_args data_args = liftM thdOf3 . go 0 0
+extractSubTerms recurse ptr_args data_args tys = do
+ dflags <- getDynFlags
+ let profile = targetProfile dflags
+ (n_primreps, r) = mapAccumL collectReps 0 tys
+ (rep_tys, make_term) = unzip r
+ (_tot_words, ptr_words, nv_rep_offsets) =
+ mkVirtHeapOffsets profile NoHeader (map NonVoid $ concat rep_tys)
+ rep_offsets = map (\(NonVoid x, off) -> (x, off)) nv_rep_offsets
+ -- index maps the Int index of each PrimRep to its ByteOff
+ index :: Array Int ByteOff
+ index = array (0, n_primreps-1) rep_offsets
+ mapM (\m -> m index ptr_words) make_term
where
- go ptr_i arr_i [] = return (ptr_i, arr_i, [])
- go ptr_i arr_i (ty:tys)
+
+ {- Collect all PrimReps from the Type, indexing each with an Int.
+ Also returns a function to construct the Term once the heap offset of
+ each indexed PrimRep is known.
+ -}
+ collectReps :: Int -- first index to use
+ -> Type
+ -> ( Int -- next available index
+ , ( [(PrimRep, Int)] -- indexed PrimReps
+ , Array Int ByteOff -> Int -> TcM Term
+ ))
+ collectReps n ty
| Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty
, isUnboxedTupleTyCon tc
- -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
- = do (ptr_i, arr_i, terms0) <-
- go ptr_i arr_i (dropRuntimeRepArgs elem_tys)
- (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
- return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)
- | otherwise
- = case typePrimRep ty of
- [rep_ty] -> do
- (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i ty rep_ty
- (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
- return (ptr_i, arr_i, term0 : terms1)
- rep_tys -> do
- (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys
- (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
- return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)
-
- go_unary_types ptr_i arr_i [] = return (ptr_i, arr_i, [])
- go_unary_types ptr_i arr_i (rep_ty:rep_tys) = do
- tv <- newVar liftedTypeKind
- (ptr_i, arr_i, term0) <- go_rep ptr_i arr_i tv rep_ty
- (ptr_i, arr_i, terms1) <- go_unary_types ptr_i arr_i rep_tys
- return (ptr_i, arr_i, term0 : terms1)
-
- go_rep ptr_i arr_i ty rep
+ -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
+ = let (n', sub) = mapAccumL collectReps n (dropRuntimeRepArgs elem_tys)
+ (reps, mk_terms) = unzip sub
+ in (n', (concat reps,
+ \idx ptr_words -> unboxedTupleTerm ty <$>
+ mapM (\mk -> mk idx ptr_words) mk_terms))
+ | otherwise =
+ case typePrimRep ty of
+ [rep] -> (n + 1
+ ,([(rep, n)]
+ ,\idx ptr_words -> mkTerm ptr_words ty rep (idx ! n)))
+ reps -> let n_reps = length reps
+ indexed_reps = zip reps [n..]
+ mk idx ptr_words =
+ unboxedTupleTerm ty <$>
+ mapM (\(rep, i) -> mkTerm ptr_words ty rep (idx ! i))
+ indexed_reps
+ in (n + n_reps, (indexed_reps, mk))
+
+
+
+ mkTerm :: Int -> Type -> PrimRep -> ByteOff -> TcM Term
+ mkTerm ptr_words ty rep byte_offset
| isGcPtrRep rep = do
- t <- recurse ty $ ptr_args !! ptr_i
- return (ptr_i + 1, arr_i, t)
+ platform <- getPlatform
+ let word_size = platformWordSizeInBytes platform
+ (word_offset, r) = byte_offset `quotRem` word_size
+ massert (word_offset < length ptr_args)
+ massert (r == 0)
+ r <- recurse ty (ptr_args !! (byte_offset `quot` word_size))
+ pure r
| otherwise = do
- -- This is a bit involved since we allow packing multiple fields
- -- within a single word. See also
- -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding
platform <- getPlatform
let word_size = platformWordSizeInBytes platform
- endian = platformByteOrder platform
- size_b = primRepSizeB platform rep
- -- Align the start offset (eg, 2-byte value should be 2-byte
- -- aligned). But not more than to a word. The offset calculation
- -- should be the same with the offset calculation in
- -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding.
- !aligned_idx = roundUpTo arr_i (min word_size size_b)
- !new_arr_i = aligned_idx + size_b
- ws | size_b < word_size =
- [index size_b aligned_idx word_size endian]
- | otherwise =
- let (q, r) = size_b `quotRem` word_size
- in assert (r == 0 )
- [ data_args !! i
- | o <- [0.. q - 1]
- , let i = (aligned_idx `quot` word_size) + o
- ]
- return (ptr_i, new_arr_i, Prim ty ws)
+ endian = platformByteOrder platform
+ size_b = primRepSizeB platform rep
+ ws | size_b < word_size
+ = [index size_b (byte_offset - word_size * ptr_words) word_size endian]
+ | otherwise
+ =
+ let (q, r) = size_b `quotRem` word_size
+ in assert (r == 0 )
+ [ data_args !! i
+ | o <- [0.. q - 1]
+ , let i = (byte_offset `quot` word_size) - ptr_words + o
+ ]
+ return (Prim ty ws)
unboxedTupleTerm ty terms
= Term ty (Right (tupleDataCon Unboxed (length terms)))
=====================================
compiler/GHC/StgToCmm/Layout.hs
=====================================
@@ -56,7 +56,8 @@ import GHC.Platform.Profile
import GHC.Unit
import GHC.Utils.Misc
-import Data.List (mapAccumL, partition)
+import Data.List (mapAccumL, partition, sortBy)
+import Data.Ord (comparing)
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)
@@ -459,10 +460,19 @@ mkVirtHeapOffsetsWithPadding profile header things =
ThunkHeader -> thunkHdrSize profile
hdr_bytes = wordsToBytes platform hdr_words
- (ptrs, non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things
+ (ptrs, unsorted_non_ptrs) = partition (isGcPtrRep . fst . fromNonVoid) things
+
+ -- Sort the non-pointer fields by their size, starting with the largest
+ -- size, so that we can pack them more efficiently.
+
+ cmp_sizes (NonVoid (rep1, _)) (NonVoid (rep2, _)) =
+ comparing (primRepSizeB platform) rep2 rep1
+
+ non_ptrs = sortBy cmp_sizes unsorted_non_ptrs
(bytes_of_ptrs, ptrs_w_offsets) =
mapAccumL computeOffset 0 ptrs
+
(tot_bytes, non_ptrs_w_offsets) =
mapAccumL computeOffset bytes_of_ptrs non_ptrs
=====================================
libraries/ghc-heap/GHC/Exts/Heap.hs
=====================================
@@ -67,10 +67,26 @@ import GHC.Exts.Heap.ClosureTypes
import GHC.Exts.Heap.Constants
import GHC.Exts.Heap.ProfInfo.Types
#if defined(PROFILING)
+import GHC.Exts.Heap.InfoTable () -- See Note [No way-dependent imports]
import GHC.Exts.Heap.InfoTableProf
#else
import GHC.Exts.Heap.InfoTable
+import GHC.Exts.Heap.InfoTableProf () -- See Note [No way-dependent imports]
+
+{-
+Note [No way-dependent imports]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+`ghc -M` currently assumes that the imports for a module are the same
+in every way. This is arguably a bug, but breaking this assumption by
+importing different things in different ways can cause trouble. For
+example, this module in the profiling way imports and uses
+GHC.Exts.Heap.InfoTableProf. When it was not also imported in the
+vanilla way, there were intermittent build failures due to this module
+being compiled in the profiling way before GHC.Exts.Heap.InfoTableProf
+in the profiling way. (#15197)
+-}
#endif
+
import GHC.Exts.Heap.Utils
import qualified GHC.Exts.Heap.FFIClosures as FFIClosures
import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI
=====================================
testsuite/tests/codeGen/should_run/T13825-unit.hs
=====================================
@@ -25,8 +25,8 @@ tests :: Ghc ()
tests = do
(_, _, off) <- runTest [("a", FloatRep), ("b", DoubleRep)]
assert_32_64 (map fmt off)
- ["F(a,4)", "F(b,8)"]
- ["F(a,8)", "P(4,12)", "F(b,16)"]
+ ["F(b,4)", "F(a,12)"]
+ ["F(b,8)", "F(a,16)", "P(4,20)"]
(_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep)]
assert_32_64 (map fmt off)
@@ -40,8 +40,8 @@ tests = do
(_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep), ("c", Int64Rep)]
assert_32_64 (map fmt off)
- ["F(a,4)", "F(b,8)", "F(c,12)"]
- ["F(a,8)", "F(b,12)", "F(c,16)"]
+ ["F(c,4)", "F(a,12)", "F(b,16)"]
+ ["F(c,8)", "F(a,16)", "F(b,20)"]
(_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", FloatRep)]
assert_32_64 (map fmt off)
@@ -50,8 +50,8 @@ tests = do
(_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", Int64Rep)]
assert_32_64 (map fmt off)
- ["F(a,4)", "F(b,12)", "F(c,16)"]
- ["F(a,8)", "F(b,16)", "P(4,20)", "F(c,24)"]
+ ["F(a,4)", "F(c,12)", "F(b,20)"]
+ ["F(a,8)", "F(c,16)", "F(b,24)", "P(4,28)"]
assert_32_64 :: (Eq a, Show a) => a -> a -> a -> Ghc ()
=====================================
testsuite/tests/interface-stability/ghc-prim-exports.stdout
=====================================
@@ -3481,6 +3481,7 @@ module GHC.PrimopWrappers where
remWord8# :: GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8#
resizeMutableByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> (# GHC.Internal.Prim.State# s, GHC.Internal.Prim.MutableByteArray# s #)
retry# :: forall a_levpoly. GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, a_levpoly #)
+ seq :: forall a b_reppoly. a -> b_reppoly -> b_reppoly
setAddrRange# :: GHC.Internal.Prim.Addr# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
setByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> GHC.Internal.Prim.State# s
setOtherThreadAllocationCounter# :: GHC.Internal.Prim.Int64# -> GHC.Internal.Prim.ThreadId# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
=====================================
testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
=====================================
@@ -3484,6 +3484,7 @@ module GHC.PrimopWrappers where
remWord8# :: GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8#
resizeMutableByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> (# GHC.Internal.Prim.State# s, GHC.Internal.Prim.MutableByteArray# s #)
retry# :: forall a_levpoly. GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, a_levpoly #)
+ seq :: forall a b_reppoly. a -> b_reppoly -> b_reppoly
setAddrRange# :: GHC.Internal.Prim.Addr# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
setByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> GHC.Internal.Prim.State# s
setOtherThreadAllocationCounter# :: GHC.Internal.Prim.Int64# -> GHC.Internal.Prim.ThreadId# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
=====================================
testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout
=====================================
@@ -29,4 +29,4 @@ size: 10
### u_maybeW32
U_MaybeW32 NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295)
-size: 9
+size: 6
=====================================
testsuite/tests/unboxedsums/UbxSumUnpackedSize.stdout-ws-32
=====================================
@@ -29,4 +29,4 @@ size: 11
### u_maybeW32
U_MaybeW32 NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295) NothingW32 (JustW32 0) NothingW32 (JustW32 4294967295)
-size: 17
+size: 11
=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -510,7 +510,7 @@ gen_wrappers (Info _ entries)
want_wrapper :: Entry -> Bool
want_wrapper entry =
and
- [ is_primop entry
+ [ (is_primop entry || is_seq_pseudoop entry)
, not $ name entry `elem` magical_primops
, not $ is_vector entry
-- We currently don't generate wrappers for vector primops.
@@ -520,6 +520,12 @@ gen_wrappers (Info _ entries)
-- suppose this choice can be revisited?
]
+ -- We also want a wrapper for the `seq` pseudoop, since GHCi
+ -- expects to find a value binding in PrimopWrappers.
+ is_seq_pseudoop :: Entry -> Bool
+ is_seq_pseudoop (PseudoOpSpec { name = n }) = n == "seq"
+ is_seq_pseudoop _ = False
+
magical_primops :: [String]
magical_primops =
[ "tagToEnum#"
=====================================
utils/genprimopcode/hie.yaml
=====================================
@@ -0,0 +1,2 @@
+cradle:
+ cabal:
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc0e9d59e614e97ab6dc1ac67251ff5...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc0e9d59e614e97ab6dc1ac67251ff5...
You're receiving this email because of your account on gitlab.haskell.org.