[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: ci: Ensure we use the correct bindist name for the test artifact when generating
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Jan 4 15:46:28 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
989bf8e5 by Zubin Duggal at 2024-01-03T20:08:47-05:00
ci: Ensure we use the correct bindist name for the test artifact when generating
release ghcup metadata
Fixes #24268
- - - - -
89299a89 by Krzysztof Gogolewski at 2024-01-03T20:09:23-05:00
Refactor: remove calls to typePrimRepArgs
The function typePrimRepArgs is just a thin wrapper around
typePrimRep, adding a VoidRep if the list is empty.
However, in StgToByteCode, we were discarding that VoidRep anyway,
so there's no point in calling it.
- - - - -
c7be0c68 by mmzk1526 at 2024-01-03T20:10:07-05:00
Use "-V" for alex version check for better backward compatibility
Fixes #24302.
In recent versions of alex, "-v" is used for "--verbose" instead of "-version".
- - - - -
762f70af by Krzysztof Gogolewski at 2024-01-04T10:46:13-05:00
Fix VoidRep handling in ghci debugger
'go' inside extractSubTerms was giving a bad result given a VoidRep,
attempting to round towards the next multiple of 0.
I don't understand much about the debugger but the code should be better
than it was.
Fixes #24306
- - - - -
ff515cd4 by Krzysztof Gogolewski at 2024-01-04T10:46:13-05:00
VoidRep-related refactor
* In GHC.StgToByteCode, replace bcIdPrimId with idPrimRep,
bcIdArgRep with idArgRep, atomPrimRep with stgArgRep1.
All of them were duplicates.
* In GHC.Stg.Unarise, we were converting a PrimRep to a Type and back to
PrimRep. Remove the calls to primRepToType and typePrimRep1 which cancel out.
* In GHC.STG.Lint, GHC.StgToCmm, GHC.Types.RepType we were filtering out
VoidRep from the result of typePrimRep. But typePrimRep never returns
VoidRep - remove the filtering.
- - - - -
15 changed files:
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/Stg/Unarise.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/StgToCmm/Layout.hs
- compiler/GHC/StgToCmm/Ticky.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/RepType.hs
- m4/fptools_alex.m4
- + testsuite/tests/ghci.debugger/scripts/T24306.hs
- + testsuite/tests/ghci.debugger/scripts/T24306.script
- + testsuite/tests/ghci.debugger/scripts/T24306.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
Changes:
=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -141,8 +141,14 @@ def mk_one_metadata(release_mode, version, job_map, artifact):
# In --release-mode, the URL in the metadata needs to point into the downloads folder
# rather then the pipeline.
if release_mode:
+ # the test artifact is bundled with the source artifact, so it doesn't have its own job name
+ # So we must manually set the name of the bindist location
+ if artifact == test_artifact:
+ bindist_name = "testsuite"
+ else
+ bindist_name = fetch_gitlab.job_triple(artifact.job_name)
final_url = release_base.format( version=version
- , bindistName=urllib.parse.quote_plus(f"{fetch_gitlab.job_triple(artifact.job_name)}.tar.xz"))
+ , bindistName=urllib.parse.quote_plus(f"{bindist_name}.tar.xz"))
else:
final_url = url
=====================================
compiler/GHC/Runtime/Heap/Inspect.hs
=====================================
@@ -888,13 +888,13 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
(ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)
| otherwise
- = case typePrimRepArgs ty of
- rep_ty :| [] -> do
+ = 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_ty :| rep_tys -> do
- (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i (rep_ty:rep_tys)
+ 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)
=====================================
compiler/GHC/Stg/Lint.hs
=====================================
@@ -381,9 +381,9 @@ lintStgAppReps fun args = do
| actual_rep == expected_rep
= match_args actual_reps_left expected_reps_left
- -- Check for void rep which can be either an empty list *or* [VoidRep]
- -- No, typePrimRep_maybe will never return a result containing VoidRep.
- -- We should refactor to make this obvious from the types.
+ -- Check for void rep (empty list)
+ -- Note typePrimRep_maybe will never return a result containing VoidRep.
+ -- We should refactor to make this obvious from the types.
| isVoidRep actual_rep && isVoidRep expected_rep
= match_args actual_reps_left expected_reps_left
@@ -410,7 +410,6 @@ lintStgAppReps fun args = do
text "unarised?:" <> ppr (lf_unarised lf))
where
isVoidRep [] = True
- isVoidRep [VoidRep] = True
isVoidRep _ = False
-- Try to strip one non-void arg rep from the current argument type returning
-- the remaining list of arguments. We return Nothing for invalid input which
=====================================
compiler/GHC/Stg/Unarise.hs
=====================================
@@ -808,15 +808,13 @@ mapSumIdBinders alt_bndr args rhs rho0
-- Select only the args which contain parts of the current field.
id_arg_exprs = [ args !! i | i <- layout1 ]
id_vars = [v | StgVarArg v <- id_arg_exprs]
- -- Output types for the field binders based on their rep
- id_tys = map primRepToType fld_reps
- typed_id_arg_input = assert (equalLength id_vars id_tys) $
- zip3 id_vars id_tys uss
+ typed_id_arg_input = assert (equalLength id_vars fld_reps) $
+ zip3 id_vars fld_reps uss
- mkCastInput :: (Id,Type,UniqSupply) -> ([(PrimOp,Type,Unique)],Id,Id)
- mkCastInput (id,tar_type,bndr_us) =
- let (ops,types) = unzip $ getCasts (typePrimRep1 $ idType id) (typePrimRep1 tar_type)
+ mkCastInput :: (Id,PrimRep,UniqSupply) -> ([(PrimOp,Type,Unique)],Id,Id)
+ mkCastInput (id,rep,bndr_us) =
+ let (ops,types) = unzip $ getCasts (typePrimRep1 $ idType id) rep
cst_opts = zip3 ops types $ uniqsFromSupply bndr_us
out_id = case cst_opts of
[] -> id
@@ -834,7 +832,7 @@ mapSumIdBinders alt_bndr args rhs rho0
typed_id_args = map StgVarArg typed_ids
-- pprTrace "mapSumIdBinders"
- -- (text "id_tys" <+> ppr id_tys $$
+ -- (text "fld_reps" <+> ppr fld_reps $$
-- text "id_args" <+> ppr id_arg_exprs $$
-- text "rhs" <+> ppr rhs $$
-- text "rhs_with_casts" <+> ppr rhs_with_casts
@@ -925,8 +923,7 @@ mkUbxSum dc ty_args args0 us
castArg us slot_ty arg
-- Cast the argument to the type of the slot if required
| slotPrimRep slot_ty /= stgArgRep1 arg
- , out_ty <- primRepToType $ slotPrimRep slot_ty
- , (ops,types) <- unzip $ getCasts (stgArgRep1 arg) $ typePrimRep1 out_ty
+ , (ops,types) <- unzip $ getCasts (stgArgRep1 arg) $ slotPrimRep slot_ty
, not . null $ ops
= let (us1,us2) = splitUniqSupply us
cast_uqs = uniqsFromSupply us1
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -57,7 +57,9 @@ import GHC.Builtin.Uniques
import GHC.Data.FastString
import GHC.Utils.Panic
import GHC.Utils.Exception (evaluate)
-import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, nonVoidIds )
+import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRep,
+ addIdReps, addArgReps,
+ nonVoidIds, nonVoidStgArgs )
import GHC.StgToCmm.Layout
import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
import GHC.Data.Bitmap
@@ -80,10 +82,8 @@ import Data.Coerce (coerce)
import Data.ByteString (ByteString)
import Data.Map (Map)
import Data.IntMap (IntMap)
-import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
-import qualified Data.List.NonEmpty as NE
import qualified GHC.Data.FiniteMap as Map
import Data.Ord
import GHC.Stack.CCS
@@ -297,11 +297,6 @@ argBits platform (rep : args)
| isFollowableArg rep = False : argBits platform args
| otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args
-non_void :: NonEmpty ArgRep -> [ArgRep]
-non_void = NE.filter nv
- where nv V = False
- nv _ = True
-
-- -----------------------------------------------------------------------------
-- schemeTopBind
@@ -378,7 +373,7 @@ schemeR_wrk fvs nm original_body (args, body)
p_init = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args))
-- make the arg bitmap
- bits = argBits platform (reverse (map (bcIdArgRep platform) all_args))
+ bits = argBits platform (reverse (map (idArgRep platform) all_args))
bitmap_size = genericLength bits
bitmap = mkBitmap platform bits
body_code <- schemeER_wrk sum_szsb_args p_init body
@@ -495,11 +490,9 @@ returnUnliftedAtom
-> StgArg
-> BcM BCInstrList
returnUnliftedAtom d s p e = do
- let reps = case e of
- StgLitArg lit -> typePrimRepArgs (literalType lit)
- StgVarArg i -> bcIdPrimReps i
+ let reps = stgArgRep e
(push, szb) <- pushAtom d p e
- ret <- returnUnliftedReps d s szb (NE.toList $! reps)
+ ret <- returnUnliftedReps d s szb reps
return (push `appOL` ret)
-- return an unlifted value from the top of the stack
@@ -512,9 +505,7 @@ returnUnliftedReps
returnUnliftedReps d s szb reps = do
profile <- getProfile
let platform = profilePlatform profile
- non_void VoidRep = False
- non_void _ = True
- ret <- case filter non_void reps of
+ ret <- case reps of
-- use RETURN for nullary/unary representations
[] -> return (unitOL $ RETURN V)
[rep] -> return (unitOL $ RETURN (toArgRep platform rep))
@@ -538,7 +529,7 @@ returnUnboxedTuple
returnUnboxedTuple d s p es = do
profile <- getProfile
let platform = profilePlatform profile
- arg_ty e = primRepCmmType platform (atomPrimRep e)
+ arg_ty e = primRepCmmType platform (stgArgRep1 e)
(call_info, tuple_components) = layoutNativeCall profile
NativeTupleReturn
d
@@ -549,10 +540,12 @@ returnUnboxedTuple d s p es = do
massert (off == dd + szb)
go (dd + szb) (push:pushes) cs
pushes <- go d [] tuple_components
+ let non_void VoidRep = False
+ non_void _ = True
ret <- returnUnliftedReps d
s
(wordsToBytes platform $ nativeCallSize call_info)
- (map atomPrimRep es)
+ (filter non_void $ map stgArgRep1 es)
return (mconcat pushes `appOL` ret)
-- Compile code to apply the given expression to the remaining args
@@ -753,11 +746,7 @@ mkConAppCode orig_d _ p con args = app_code
let platform = profilePlatform profile
non_voids =
- [ NonVoid (prim_rep, arg)
- | arg <- args
- , let prim_rep = atomPrimRep arg
- , not (isVoidRep prim_rep)
- ]
+ addArgReps (nonVoidStgArgs args)
(_, _, args_offsets) =
mkVirtHeapOffsetsWithPadding profile StdHeader non_voids
@@ -866,7 +855,7 @@ doCase d s p scrut bndr alts
-- have the same runtime rep. We have more efficient specialized
-- return frames for the situations with one non-void element.
- non_void_arg_reps = non_void (typeArgReps platform bndr_ty)
+ non_void_arg_reps = typeArgReps platform bndr_ty
ubx_tuple_frame =
(isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty) &&
length non_void_arg_reps > 1
@@ -899,7 +888,7 @@ doCase d s p scrut bndr alts
(bndr_size, call_info, args_offsets)
| ubx_tuple_frame =
let bndr_ty = primRepCmmType platform
- bndr_reps = NE.filter (not.isVoidRep) (bcIdPrimReps bndr)
+ bndr_reps = typePrimRep (idType bndr)
(call_info, args_offsets) =
layoutNativeCall profile NativeTupleReturn 0 bndr_ty bndr_reps
in ( wordsToBytes platform (nativeCallSize call_info)
@@ -939,7 +928,7 @@ doCase d s p scrut bndr alts
rhs_code <- schemeE d_alts s p_alts rhs
return (my_discr alt, rhs_code)
| isUnboxedTupleType bndr_ty || isUnboxedSumType bndr_ty =
- let bndr_ty = primRepCmmType platform . bcIdPrimRep
+ let bndr_ty = primRepCmmType platform . idPrimRep
tuple_start = d_bndr
(call_info, args_offsets) =
layoutNativeCall profile
@@ -955,7 +944,7 @@ doCase d s p scrut bndr alts
wordsToBytes platform (nativeCallSize call_info) +
offset)
| (arg, offset) <- args_offsets
- , not (isVoidRep $ bcIdPrimRep arg)]
+ , not (isVoidRep $ idPrimRep arg)]
p_alts
in do
rhs_code <- schemeE stack_bot s p' rhs
@@ -964,9 +953,7 @@ doCase d s p scrut bndr alts
| otherwise =
let (tot_wds, _ptrs_wds, args_offsets) =
mkVirtHeapOffsets profile NoHeader
- [ NonVoid (bcIdPrimRep id, id)
- | NonVoid id <- nonVoidIds real_bndrs
- ]
+ (addIdReps (nonVoidIds real_bndrs))
size = WordOff tot_wds
stack_bot = d_alts + wordsToBytes platform size
@@ -1060,7 +1047,7 @@ doCase d s p scrut bndr alts
rel_slots = IntSet.toAscList $ IntSet.fromList $ Map.elems $ Map.mapMaybeWithKey spread p
spread id offset | isUnboxedTupleType (idType id) ||
isUnboxedSumType (idType id) = Nothing
- | isFollowableArg (bcIdArgRep platform id) = Just (fromIntegral rel_offset)
+ | isFollowableArg (idArgRep platform id) = Just (fromIntegral rel_offset)
| otherwise = Nothing
where rel_offset = bytesToWords platform (d - offset)
@@ -1486,7 +1473,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args
return ((code, AddrRep) : rest)
pargs d (aa:az) = do (code_a, sz_a) <- pushAtom d p aa
rest <- pargs (d + sz_a) az
- return ((code_a, atomPrimRep aa) : rest)
+ return ((code_a, stgArgRep1 aa) : rest)
code_n_reps <- pargs d0 args_r_to_l
let
@@ -1695,19 +1682,15 @@ maybe_getCCallReturnRep :: Type -> Maybe PrimRep
maybe_getCCallReturnRep fn_ty
= let
(_a_tys, r_ty) = splitFunTys (dropForAlls fn_ty)
- r_reps = typePrimRepArgs r_ty
-
- blargh :: a -- Used at more than one type
- blargh = pprPanic "maybe_getCCallReturn: can't handle:"
- (pprType fn_ty)
in
- case r_reps of
- VoidRep :| [] -> Nothing
- rep :| [] -> Just rep
+ case typePrimRep r_ty of
+ [] -> Nothing
+ [rep] -> Just rep
-- if it was, it would be impossible to create a
-- valid return value placeholder on the stack
- _ -> blargh
+ _ -> pprPanic "maybe_getCCallReturn: can't handle:"
+ (pprType fn_ty)
maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (Id, [Name])
-- Detect and extract relevant info for the tagToEnum kludge.
@@ -2138,7 +2121,7 @@ lookupBCEnv_maybe :: Id -> BCEnv -> Maybe ByteOff
lookupBCEnv_maybe = Map.lookup
idSizeW :: Platform -> Id -> WordOff
-idSizeW platform = WordOff . argRepSizeW platform . bcIdArgRep platform
+idSizeW platform = WordOff . argRepSizeW platform . idArgRep platform
idSizeCon :: Platform -> Id -> ByteOff
idSizeCon platform var
@@ -2147,22 +2130,8 @@ idSizeCon platform var
isUnboxedSumType (idType var) =
wordsToBytes platform .
WordOff . sum . map (argRepSizeW platform . toArgRep platform) .
- NE.toList . bcIdPrimReps $ var
- | otherwise = ByteOff (primRepSizeB platform (bcIdPrimRep var))
-
-bcIdArgRep :: Platform -> Id -> ArgRep
-bcIdArgRep platform = toArgRep platform . bcIdPrimRep
-
-bcIdPrimRep :: Id -> PrimRep
-bcIdPrimRep id
- | rep :| [] <- typePrimRepArgs (idType id)
- = rep
- | otherwise
- = pprPanic "bcIdPrimRep" (ppr id <+> dcolon <+> ppr (idType id))
-
-
-bcIdPrimReps :: Id -> NonEmpty PrimRep
-bcIdPrimReps id = typePrimRepArgs (idType id)
+ typePrimRep . idType $ var
+ | otherwise = ByteOff (primRepSizeB platform (idPrimRep var))
repSizeWords :: Platform -> PrimRep -> WordOff
repSizeWords platform rep = WordOff $ argRepSizeW platform (toArgRep platform rep)
@@ -2201,12 +2170,8 @@ mkSlideW !n !ws
-atomPrimRep :: StgArg -> PrimRep
-atomPrimRep (StgVarArg v) = bcIdPrimRep v
-atomPrimRep (StgLitArg l) = typePrimRep1 (literalType l)
-
atomRep :: Platform -> StgArg -> ArgRep
-atomRep platform e = toArgRep platform (atomPrimRep e)
+atomRep platform e = toArgRep platform (stgArgRep1 e)
-- | Let szsw be the sizes in bytes of some items pushed onto the stack, which
-- has initial depth @original_depth at . Return the values which the stack
@@ -2214,8 +2179,8 @@ atomRep platform e = toArgRep platform (atomPrimRep e)
mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff]
mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb)
-typeArgReps :: Platform -> Type -> NonEmpty ArgRep
-typeArgReps platform = NE.map (toArgRep platform) . typePrimRepArgs
+typeArgReps :: Platform -> Type -> [ArgRep]
+typeArgReps platform = map (toArgRep platform) . typePrimRep
-- -----------------------------------------------------------------------------
-- The bytecode generator's monad
=====================================
compiler/GHC/StgToCmm.hs
=====================================
@@ -257,7 +257,7 @@ cgDataCon mn data_con
arg_reps = [ NonVoid rep_ty
| ty <- dataConRepArgTys data_con
, rep_ty <- typePrimRep (scaledThing ty)
- , not (isVoidRep rep_ty) ]
+ ]
; emitClosureAndInfoTable platform dyn_info_tbl NativeDirectCall [] $
-- NB: the closure pointer is assumed *untagged* on
=====================================
compiler/GHC/StgToCmm/Layout.hs
=====================================
@@ -26,7 +26,7 @@ module GHC.StgToCmm.Layout (
mkVirtConstrSizes,
getHpRelOffset,
- ArgRep(..), toArgRep, argRepSizeW, -- re-exported from GHC.StgToCmm.ArgRep
+ ArgRep(..), toArgRep, idArgRep, argRepSizeW, -- re-exported from GHC.StgToCmm.ArgRep
getArgAmode, getNonVoidArgAmodes
) where
@@ -328,10 +328,10 @@ getArgRepsAmodes args = do
platform <- profilePlatform <$> getProfile
mapM (getArgRepAmode platform) args
where getArgRepAmode platform arg
- | V <- rep = return (V, Nothing)
- | otherwise = do expr <- getArgAmode (NonVoid arg)
- return (rep, Just expr)
- where rep = toArgRep platform (stgArgRep1 arg)
+ = case stgArgRep1 arg of
+ VoidRep -> return (V, Nothing)
+ rep -> do expr <- getArgAmode (NonVoid arg)
+ return (toArgRep platform rep, Just expr)
nonVArgs :: [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
nonVArgs [] = []
@@ -603,12 +603,7 @@ getArgAmode (NonVoid (StgLitArg lit)) = cgLit lit
getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
-- NB: Filters out void args,
-- so the result list may be shorter than the argument list
-getNonVoidArgAmodes [] = return []
-getNonVoidArgAmodes (arg:args)
- | isVoidRep (stgArgRep1 arg) = getNonVoidArgAmodes args
- | otherwise = do { amode <- getArgAmode (NonVoid arg)
- ; amodes <- getNonVoidArgAmodes args
- ; return ( amode : amodes ) }
+getNonVoidArgAmodes args = mapM getArgAmode (nonVoidStgArgs args)
-------------------------------------------------------------------------
--
=====================================
compiler/GHC/StgToCmm/Ticky.hs
=====================================
@@ -587,7 +587,7 @@ tickyDirectCall :: RepArity -> [StgArg] -> FCode ()
tickyDirectCall arity args
| args `lengthIs` arity = tickyKnownCallExact
| otherwise = do tickyKnownCallExtraArgs
- tickySlowCallPat (map stgArgRep1 (drop arity args))
+ tickySlowCallPat (drop arity args)
tickyKnownCallTooFewArgs :: FCode ()
tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter (fsLit "KNOWN_CALL_TOO_FEW_ARGS_ctr")
@@ -610,12 +610,12 @@ tickySlowCall lf_info args = do
if isKnownFun lf_info
then tickyKnownCallTooFewArgs
else tickyUnknownCall
- tickySlowCallPat (map stgArgRep1 args)
+ tickySlowCallPat args
-tickySlowCallPat :: [PrimRep] -> FCode ()
+tickySlowCallPat :: [StgArg] -> FCode ()
tickySlowCallPat args = ifTicky $ do
platform <- profilePlatform <$> getProfile
- let argReps = map (toArgRep platform) args
+ let argReps = map (toArgRep platform . stgArgRep1) args
(_, n_matched) = slowCallPattern argReps
if n_matched > 0 && args `lengthIs` n_matched
then bumpTickyLbl $ mkRtsSlowFastTickyCtrLabel $ concatMap (map Data.Char.toLower . argRepString) argReps
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -1525,11 +1525,10 @@ shouldUnpackArgTy bang_opts prag fam_envs arg_ty
-- and tells us if they can fit into 8 bytes. See Note [Unpack one-wide fields]
is_small_rep =
let -- Neccesary to look through unboxed tuples.
+ -- Note typePrimRep never returns VoidRep
prim_reps = concatMap (typePrimRep . scaledThing . fst) $ rep_tys
- -- Void types are erased when unpacked so we
- nv_prim_reps = filter (not . isVoidRep) prim_reps
-- And then get the actual size of the unpacked constructor.
- rep_size = sum $ map primRepSizeW64_B nv_prim_reps
+ rep_size = sum $ map primRepSizeW64_B prim_reps
in rep_size <= 8
is_sum :: [DataCon] -> Bool
=====================================
compiler/GHC/Types/RepType.hs
=====================================
@@ -160,21 +160,18 @@ dataConRuntimeRepStrictness dc =
go repMarks repTys []
where
go (mark:marks) (ty:types) out_marks
- -- Zero-width argument, mark is irrelevant at runtime.
- | -- pprTrace "VoidTy" (ppr ty) $
- (isZeroBitTy ty)
- = go marks types out_marks
- -- Single rep argument, e.g. Int
- -- Keep mark as-is
- | [_] <- reps
- = go marks types (mark:out_marks)
- -- Multi-rep argument, e.g. (# Int, Bool #) or (# Int | Bool #)
- -- Make up one non-strict mark per runtime argument.
- | otherwise -- TODO: Assert real_reps /= null
- = go marks types ((replicate (length real_reps) NotMarkedStrict)++out_marks)
+ = case reps of
+ -- Zero-width argument, mark is irrelevant at runtime.
+ [] -> -- pprTrace "VoidTy" (ppr ty) $
+ go marks types out_marks
+ -- Single rep argument, e.g. Int
+ -- Keep mark as-is
+ [_] -> go marks types (mark:out_marks)
+ -- Multi-rep argument, e.g. (# Int, Bool #) or (# Int | Bool #)
+ -- Make up one non-strict mark per runtime argument.
+ _ -> go marks types ((replicate (length reps) NotMarkedStrict)++out_marks)
where
reps = typePrimRep ty
- real_reps = filter (not . isVoidRep) $ reps
go [] [] out_marks = reverse out_marks
go _m _t _o = pprPanic "dataConRuntimeRepStrictness2" (ppr dc $$ ppr _m $$ ppr _t $$ ppr _o)
=====================================
m4/fptools_alex.m4
=====================================
@@ -14,7 +14,7 @@ AC_SUBST(AlexCmd,$ALEX)
AC_CACHE_CHECK([for version of alex], fptools_cv_alex_version,
changequote(, )dnl
[if test x"$AlexCmd" != x; then
- fptools_cv_alex_version=`"$AlexCmd" -v |
+ fptools_cv_alex_version=`"$AlexCmd" -V |
grep 'Alex [Vv]ersion' | sed -e 's/Alex [Vv]ersion \([0-9\.]*\).*/\1/g'` ;
else
fptools_cv_alex_version="";
=====================================
testsuite/tests/ghci.debugger/scripts/T24306.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE UnboxedTuples, UnliftedNewtypes, DataKinds, MagicHash #-}
+module T24306 where
+
+import GHC.Exts
+
+newtype A = MkA (# #)
+data T = T Int# A Int#
+
+x = T 1# (MkA (# #)) 2#
=====================================
testsuite/tests/ghci.debugger/scripts/T24306.script
=====================================
@@ -0,0 +1,2 @@
+:load T24306
+:force x
=====================================
testsuite/tests/ghci.debugger/scripts/T24306.stdout
=====================================
@@ -0,0 +1 @@
+x = T 1 (MkA (##)) 2
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -140,3 +140,4 @@ test('break030',
['break030.script'],
)
test('T23057', [only_ghci, extra_hc_opts('-fno-break-points')], ghci_script, ['T23057.script'])
+test('T24306', normal, ghci_script, ['T24306.script'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9a261eb7855cae677e86e516181beac3b7fb43d...ff515cd42501eb4cb20a5ff63f2cf8637d9f7bd5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9a261eb7855cae677e86e516181beac3b7fb43d...ff515cd42501eb4cb20a5ff63f2cf8637d9f7bd5
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240104/eb98e10b/attachment-0001.html>
More information about the ghc-commits
mailing list