[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