Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bc8ddbba by Simon Jakobi at 2026-10-27T18:30:00-04:00 X86 NCG: use 32-bit POPCNT for sub-word popcounts A 32-bit write zero-extends the result to the full register, so we don't need to emit additional code for this. We also skip emitting zero-extension instructions for the argument when it is already visibly zero-extended. For the byte-wise popcount loop from #24813, this shrinks the popcount sequence from 5 instructions to 3. Assisted-by: Claude Fable 5.1 - - - - - eac8649f by Facundo Domínguez at 2026-10-27T18:30:04-04:00 Use a ShortByteString in Serialized instead of [Word8] This makes the in-memory representation 40x more compact for all values stored in annotations. A test is added to measure the representation size of annotations specified in the compiler input. The GHC API is modified. All functions that previously handled annotations in [Word8] form now use ShortByteString. The following definitions have modified types: * GHC.findGlobalAnns * GHC.Tc.Gen.Splice.getAnnotationsByTypeRep * GHC.Core.Opt.Monad.getAnnotations * GHC.Core.Opt.Monad.getFirstAnnotations * GHC.Types.Annotations.deserializeAnns * GHC.Types.Annotations.findAnns * GHC.Types.Annotations.findAnnsByTypeRep * GHC.Serialized.Serialized * GHC.Serialized.toSerialized * GHC.Serialized.fromSerialized * GHC.Serialized.serializeWithData * GHC.Serialized.deserializeWithData * GHCi.Message.ReifyAnnotations Fixes #28002. - - - - - 22 changed files: - + changelog.d/T28002 - + changelog.d/T28002-api - + changelog.d/ncg-x86-subword-popcnt - compiler/GHC.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Types/Annotations.hs - compiler/GHC/Utils/Outputable.hs - libraries/ghc-boot/GHC/Serialized.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/TH.hs - libraries/ghci/GHCi/TH/Binary.hs - testsuite/tests/annotations/should_run/Makefile - + testsuite/tests/annotations/should_run/T16841.hs - + testsuite/tests/annotations/should_run/T16841.stdout - testsuite/tests/annotations/should_run/all.T - + testsuite/tests/codeGen/should_gen_asm/T24813.asm - + testsuite/tests/codeGen/should_gen_asm/T24813.cmm - testsuite/tests/codeGen/should_gen_asm/all.T - testsuite/tests/plugins/T26761Plugin.hs - testsuite/tests/plugins/all.T Changes: ===================================== changelog.d/T28002 ===================================== @@ -0,0 +1,8 @@ +section: compiler +issues: #28002 +mrs: !16841 +synopsis: + Use ``ShortByteString`` in the ``Serialized`` type instead of ``[Word8]`` +description: + ``GHC.Serialized.Serialized`` now uses ``ByteString`` to store serialized data. + This makes in-memory representation more compact. ===================================== changelog.d/T28002-api ===================================== @@ -0,0 +1,21 @@ +section: ghc-lib +issues: #28002 +mrs: !16841 +synopsis: + Use ``ShortByteString`` in the ``Serialized`` type instead of ``[Word8]`` +description: + Breaking change: All functions that previously handled annotations in ``[Word8]`` + form now use ``ShortByteString``. The following definitions have modified types: + * ``GHC.findGlobalAnns`` + * ``GHC.Tc.Gen.Splice.getAnnotationsByTypeRep`` + * ``GHC.Core.Opt.Monad.getAnnotations`` + * ``GHC.Core.Opt.Monad.getFirstAnnotations`` + * ``GHC.Types.Annotations.deserializeAnns`` + * ``GHC.Types.Annotations.findAnns`` + * ``GHC.Types.Annotations.findAnnsByTypeRep`` + * ``GHC.Serialized.Serialized`` + * ``GHC.Serialized.toSerialized`` + * ``GHC.Serialized.fromSerialized`` + * ``GHC.Serialized.serializeWithData`` + * ``GHC.Serialized.deserializeWithData`` + * ``GHCi.Message.ReifyAnnotations`` ===================================== changelog.d/ncg-x86-subword-popcnt ===================================== @@ -0,0 +1,5 @@ +section: compiler +synopsis: The x86 native code generator now emits shorter code for 8-bit and + 16-bit ``popCount`` when :ghc-flag:`-msse4.2` is enabled. +mrs: !16640 +issues: #24813 ===================================== compiler/GHC.hs ===================================== @@ -453,12 +453,12 @@ import qualified GHC.Unit.Home.Graph as HUG import Control.Applicative ((<|>)) import Control.Monad import Control.Monad.Catch as MC +import Data.ByteString.Short (ShortByteString) import Data.Foldable import Data.Function ((&)) import Data.IORef import Data.List (isPrefixOf) import Data.Typeable ( Typeable ) -import Data.Word ( Word8 ) import qualified Data.Map.Strict as Map import Data.Set (Set) @@ -1526,7 +1526,7 @@ lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing) lookupGlobalName name = withSession $ \hsc_env -> do liftIO $ lookupType hsc_env name -findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a] +findGlobalAnns :: (GhcMonad m, Typeable a) => (ShortByteString -> a) -> AnnTarget Name -> m [a] findGlobalAnns deserialize target = withSession $ \hsc_env -> do ann_env <- liftIO $ prepareAnnotations hsc_env Nothing return (findAnns deserialize ann_env target) ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -6739,20 +6739,23 @@ genPopCnt bid width dst src = do True -> do code_src <- getAnyReg src - src_r <- getNewRegNat format + -- Sub-word popcounts use 32-bit POPCNT, whose write zero-extends the + -- result to the full register. + src_r <- getNewRegNat (max II32 format) let dst_r = getRegisterReg platform (CmmLocal dst) + -- A sub-word argument is a full Word# whose upper bits may be + -- dirty, so zero-extend it unless it visibly already is. + zx_src + | CmmMachOp (MO_UU_Conv from _) [_] <- src, from <= width + = nilOL + | otherwise + = unitOL (MOVZxL format (OpReg src_r) (OpReg src_r)) return $ code_src src_r `appOL` - (if width == W8 then - -- The POPCNT instruction doesn't take a r/m8 - unitOL (MOVZxL II8 (OpReg src_r) (OpReg src_r)) `appOL` - unitOL (POPCNT II16 (OpReg src_r) dst_r) - else - unitOL (POPCNT format (OpReg src_r) dst_r)) `appOL` (if width == W8 || width == W16 then - -- We used a 16-bit destination register above, - -- so zero-extend - unitOL (MOVZxL II16 (OpReg dst_r) (OpReg dst_r)) - else nilOL) + zx_src `appOL` + unitOL (POPCNT II32 (OpReg src_r) dst_r) + else + unitOL (POPCNT format (OpReg src_r) dst_r)) False -> -- generate C call to hs_popcntN in ghc-prim ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -68,9 +68,9 @@ import GHC.Unit.Module.ModGuts import GHC.Unit.External import Data.Bifunctor ( bimap ) +import Data.ByteString.Short ( ShortByteString ) import Data.Dynamic import Data.Maybe (listToMaybe) -import Data.Word import Control.Monad import Control.Applicative ( Alternative(..) ) @@ -323,14 +323,14 @@ get_eps = do -- annotations. -- -- See Note [Annotations] -getAnnotations :: Typeable a => ([Word8] -> a) -> ModGuts -> CoreM (ModuleEnv [a], NameEnv [a]) +getAnnotations :: Typeable a => (ShortByteString -> a) -> ModGuts -> CoreM (ModuleEnv [a], NameEnv [a]) getAnnotations deserialize guts = do hsc_env <- getHscEnv ann_env <- liftIO $ prepareAnnotations hsc_env (Just guts) return (deserializeAnns deserialize ann_env) -- | Get at most one annotation of a given type per annotatable item. -getFirstAnnotations :: Typeable a => ([Word8] -> a) -> ModGuts -> CoreM (ModuleEnv a, NameEnv a) +getFirstAnnotations :: Typeable a => (ShortByteString -> a) -> ModGuts -> CoreM (ModuleEnv a, NameEnv a) getFirstAnnotations deserialize guts = bimap mod name <$> getAnnotations deserialize guts where ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -155,10 +155,10 @@ import Control.DeepSeq import Control.Monad import Data.Binary import Data.Binary.Get +import Data.ByteString.Short (ShortByteString) import Data.Containers.ListUtils ( nubOrd ) import Data.List ( sortBy ) import Data.Maybe -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Dynamic ( fromDynamic, toDyn ) import qualified Data.IntMap as IntMap @@ -1947,7 +1947,7 @@ handleTHMessage msg = case msg of ReifyInstances n ts -> wrapTHResult $ runQinTcM $ TH.reifyInstances n ts ReifyRoles n -> wrapTHResult $ runQinTcM $ TH.reifyRoles n ReifyAnnotations lookup tyrep -> - wrapTHResult $ (map B.pack <$> getAnnotationsByTypeRep lookup tyrep) + wrapTHResult $ getAnnotationsByTypeRep lookup tyrep ReifyModule m -> wrapTHResult $ runQinTcM $ TH.reifyModule m ReifyConStrictness nm -> wrapTHResult $ runQinTcM $ TH.reifyConStrictness nm GetPackageRoot -> wrapTHResult $ runQinTcM $ TH.getPackageRoot @@ -1967,7 +1967,7 @@ handleTHMessage msg = case msg of FailIfErrs -> wrapTHResult failIfErrsM _ -> panic ("handleTHMessage: unexpected message " ++ show msg) -getAnnotationsByTypeRep :: TH.AnnLookup -> TypeRep -> TcM [[Word8]] +getAnnotationsByTypeRep :: TH.AnnLookup -> TypeRep -> TcM [ShortByteString] getAnnotationsByTypeRep th_name tyrep = do { name <- lookupThAnnLookup th_name ; topEnv <- getTopEnv ===================================== compiler/GHC/Types/Annotations.hs ===================================== @@ -27,9 +27,9 @@ import GHC.Utils.Outputable import GHC.Serialized import Control.Monad +import Data.ByteString.Short ( ShortByteString ) import Data.Maybe import Data.Typeable -import Data.Word ( Word8 ) import Control.DeepSeq -- | Represents an annotation after it has been sufficiently desugared from @@ -112,14 +112,14 @@ plusAnnEnv a b = -- | Find the annotations attached to the given target as 'Typeable' -- values of your choice. If no deserializer is specified, -- only transient annotations will be returned. -findAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> CoreAnnTarget -> [a] +findAnns :: Typeable a => (ShortByteString -> a) -> AnnEnv -> CoreAnnTarget -> [a] findAnns deserialize env = mapMaybe (fromSerialized deserialize) . findAnnPayloads env -- | Find the annotations attached to the given target as 'Typeable' -- values of your choice. If no deserializer is specified, -- only transient annotations will be returned. -findAnnsByTypeRep :: AnnEnv -> CoreAnnTarget -> TypeRep -> [[Word8]] +findAnnsByTypeRep :: AnnEnv -> CoreAnnTarget -> TypeRep -> [ShortByteString] findAnnsByTypeRep env target tyrep = [ ws | Serialized tyrep' ws <- findAnnPayloads env target , tyrep' == tyrep ] @@ -134,7 +134,7 @@ findAnnPayloads env target = -- | Deserialize all annotations of a given type. This happens lazily, that is -- no deserialization will take place until the [a] is actually demanded and -- the [a] can also be empty (the UniqFM is not filtered). -deserializeAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> (ModuleEnv [a], NameEnv [a]) +deserializeAnns :: Typeable a => (ShortByteString -> a) -> AnnEnv -> (ModuleEnv [a], NameEnv [a]) deserializeAnns deserialize env = ( mapModuleEnv deserAnns (ann_mod_env env) , mapNameEnv deserAnns (ann_name_env env) ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -138,6 +138,7 @@ import GHC.Utils.Misc (lastMaybe, snocView) import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import qualified Data.ByteString.Short as Short import Data.Char import qualified Data.Map as M import Data.Int @@ -1105,7 +1106,7 @@ instance Outputable a => Outputable (SCC a) where ppr (CyclicSCC vs) = text "REC" $$ (nest 3 (vcat (map ppr vs))) instance Outputable Serialized where - ppr (Serialized the_type bytes) = int (length bytes) <+> text "of type" <+> text (show the_type) + ppr (Serialized the_type bytes) = int (Short.length bytes) <+> text "of type" <+> text (show the_type) instance Outputable Extension where ppr = text . show ===================================== libraries/ghc-boot/GHC/Serialized.hs ===================================== @@ -19,144 +19,68 @@ module GHC.Serialized ( ) where import Prelude -- See note [Why do we import Prelude here?] -import Data.Bits -import Data.Word ( Word8 ) -import Data.Data import Control.DeepSeq +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import Data.ByteString.Short (ShortByteString) +import qualified Data.ByteString.Short as Short +import qualified Data.ByteString.Lazy as ByteString.Lazy +import Data.Data -- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types -data Serialized = Serialized TypeRep [Word8] +data Serialized = Serialized TypeRep ShortByteString instance NFData Serialized where rnf (Serialized tr ws) = rnf tr `seq` rnf ws -- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later -toSerialized :: forall a. Typeable a => (a -> [Word8]) -> a -> Serialized +toSerialized :: forall a. Typeable a => (a -> ShortByteString) -> a -> Serialized toSerialized serialize what = Serialized (typeOf what) (serialize what) -- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that. -- Otherwise return @Nothing@. -fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a +fromSerialized :: forall a. Typeable a => (ShortByteString -> a) -> Serialized -> Maybe a fromSerialized deserialize (Serialized the_type bytes) | the_type == rep = Just (deserialize bytes) | otherwise = Nothing where rep = typeRep (Proxy :: Proxy a) -- | Use a 'Data' instance to implement a serialization scheme dual to that of 'deserializeWithData' -serializeWithData :: Data a => a -> [Word8] -serializeWithData what = serializeWithData' what [] - -serializeWithData' :: Data a => a -> [Word8] -> [Word8] -serializeWithData' what = fst $ gfoldl (\(before, a_to_b) a -> (before . serializeWithData' a, a_to_b a)) - (\x -> (serializeConstr (constrRep (toConstr what)), x)) - what +serializeWithData :: Data a => a -> ShortByteString +serializeWithData = Short.toShort . ByteString.Lazy.toStrict . runPut . putData -- | Use a 'Data' instance to implement a deserialization scheme dual to that of 'serializeWithData' -deserializeWithData :: Data a => [Word8] -> a -deserializeWithData = snd . deserializeWithData' - -deserializeWithData' :: forall a. Data a => [Word8] -> ([Word8], a) -deserializeWithData' bytes = deserializeConstr bytes $ \constr_rep bytes -> - gunfold (\(bytes, b_to_r) -> let (bytes', b) = deserializeWithData' bytes in (bytes', b_to_r b)) - (\x -> (bytes, x)) - (repConstr (dataTypeOf (undefined :: a)) constr_rep) - - -serializeConstr :: ConstrRep -> [Word8] -> [Word8] -serializeConstr (AlgConstr ix) = serializeWord8 1 . serializeInt ix -serializeConstr (IntConstr i) = serializeWord8 2 . serializeInteger i -serializeConstr (FloatConstr r) = serializeWord8 3 . serializeRational r -serializeConstr (CharConstr c) = serializeWord8 4 . serializeChar c - - -deserializeConstr :: [Word8] -> (ConstrRep -> [Word8] -> a) -> a -deserializeConstr bytes k = deserializeWord8 bytes $ \constr_ix bytes -> - case constr_ix of - 1 -> deserializeInt bytes $ \ix -> k (AlgConstr ix) - 2 -> deserializeInteger bytes $ \i -> k (IntConstr i) - 3 -> deserializeRational bytes $ \r -> k (FloatConstr r) - 4 -> deserializeChar bytes $ \c -> k (CharConstr c) - x -> error $ "deserializeConstr: unrecognised serialized constructor type " ++ show x ++ " in context " ++ show bytes - - -serializeFixedWidthNum :: forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8] -serializeFixedWidthNum what = go (finiteBitSize what) what - where - go :: Int -> a -> [Word8] -> [Word8] - go size current rest - | size <= 0 = rest - | otherwise = fromIntegral (current .&. 255) : go (size - 8) (current `shiftR` 8) rest - -deserializeFixedWidthNum :: forall a b. (Integral a, FiniteBits a) => [Word8] -> (a -> [Word8] -> b) -> b -deserializeFixedWidthNum bytes k = go (finiteBitSize (undefined :: a)) bytes k - where - go :: Int -> [Word8] -> (a -> [Word8] -> b) -> b - go size bytes k - | size <= 0 = k 0 bytes - | otherwise = case bytes of - (byte:bytes) -> go (size - 8) bytes (\x -> k ((x `shiftL` 8) .|. fromIntegral byte)) - [] -> error "deserializeFixedWidthNum: unexpected end of stream" - - -serializeEnum :: (Enum a) => a -> [Word8] -> [Word8] -serializeEnum = serializeInt . fromEnum - -deserializeEnum :: Enum a => [Word8] -> (a -> [Word8] -> b) -> b -deserializeEnum bytes k = deserializeInt bytes (k . toEnum) - - -serializeWord8 :: Word8 -> [Word8] -> [Word8] -serializeWord8 x = (x:) - -deserializeWord8 :: [Word8] -> (Word8 -> [Word8] -> a) -> a -deserializeWord8 (byte:bytes) k = k byte bytes -deserializeWord8 [] _ = error "deserializeWord8: unexpected end of stream" - - -serializeInt :: Int -> [Word8] -> [Word8] -serializeInt = serializeFixedWidthNum - -deserializeInt :: [Word8] -> (Int -> [Word8] -> a) -> a -deserializeInt = deserializeFixedWidthNum - - -serializeRational :: (Real a) => a -> [Word8] -> [Word8] -serializeRational = serializeString . show . toRational - -deserializeRational :: (Fractional a) => [Word8] -> (a -> [Word8] -> b) -> b -deserializeRational bytes k = deserializeString bytes (k . fromRational . read) - - -serializeInteger :: Integer -> [Word8] -> [Word8] -serializeInteger = serializeString . show - -deserializeInteger :: [Word8] -> (Integer -> [Word8] -> a) -> a -deserializeInteger bytes k = deserializeString bytes (k . read) - - -serializeChar :: Char -> [Word8] -> [Word8] -serializeChar = serializeString . show - -deserializeChar :: [Word8] -> (Char -> [Word8] -> a) -> a -deserializeChar bytes k = deserializeString bytes (k . read) - - -serializeString :: String -> [Word8] -> [Word8] -serializeString = serializeList serializeEnum - -deserializeString :: [Word8] -> (String -> [Word8] -> a) -> a -deserializeString = deserializeList deserializeEnum - - -serializeList :: (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8] -serializeList serialize_element xs = serializeInt (length xs) . foldr (.) id (map serialize_element xs) - -deserializeList :: forall a b. (forall c. [Word8] -> (a -> [Word8] -> c) -> c) - -> [Word8] -> ([a] -> [Word8] -> b) -> b -deserializeList deserialize_element bytes k = deserializeInt bytes $ \len bytes -> go len bytes k - where - go :: Int -> [Word8] -> ([a] -> [Word8] -> b) -> b - go len bytes k - | len <= 0 = k [] bytes - | otherwise = deserialize_element bytes (\elt bytes -> go (len - 1) bytes (k . (elt:))) +deserializeWithData :: Data a => ShortByteString -> a +deserializeWithData bs = + case runGetOrFail getData (ByteString.Lazy.fromStrict (Short.fromShort bs)) of + Right (_, _, x) -> x + Left (_, off, msg) -> + error ("deserializeWithData: " ++ msg ++ " at offset " ++ show off) + +putData :: Data a => a -> Put +putData x = do + putConstrRep (constrRep (toConstr x)) + sequence_ (gmapQ putData x) + +getData :: forall a. Data a => Get a +getData = do + rep <- getConstrRep + fromConstrM getData (repConstr (dataTypeOf (undefined :: a)) rep) + +putConstrRep :: ConstrRep -> Put +putConstrRep (AlgConstr ix) = putWord8 1 >> put ix +putConstrRep (IntConstr i) = putWord8 2 >> put i +putConstrRep (FloatConstr r) = putWord8 3 >> put r +putConstrRep (CharConstr c) = putWord8 4 >> put c + +getConstrRep :: Get ConstrRep +getConstrRep = do + tag <- getWord8 + case tag of + 1 -> AlgConstr <$> get + 2 -> IntConstr <$> get + 3 -> FloatConstr <$> get + 4 -> CharConstr <$> get + _ -> fail ("unrecognised constructor tag " ++ show tag) ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -297,7 +297,7 @@ data THMessage a where ReifyInstances :: TH.Name -> [TH.Type] -> THMessage (THResult [TH.Dec]) ReifyRoles :: TH.Name -> THMessage (THResult [TH.Role]) ReifyAnnotations :: TH.AnnLookup -> TypeRep - -> THMessage (THResult [ByteString]) + -> THMessage (THResult [BS.ShortByteString]) ReifyModule :: TH.Module -> THMessage (THResult TH.ModuleInfo) ReifyConStrictness :: TH.Name -> THMessage (THResult [TH.DecidedStrictness]) ===================================== libraries/ghci/GHCi/TH.hs ===================================== @@ -100,7 +100,6 @@ import Control.Monad.IO.Class (MonadIO (..)) import Data.Binary import Data.Binary.Put import Data.ByteString (ByteString) -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Data import Data.Dynamic @@ -169,7 +168,7 @@ instance MonadIO GHCiQ where -- serialize irrelevant annotations. reifyAnnotations :: forall a . Data a => TH.AnnLookup -> GHCiQ [a] reifyAnnotations lookup = - map (deserializeWithData . B.unpack) <$> + map deserializeWithData <$> ghcCmd (ReifyAnnotations lookup typerep) where typerep = typeOf (undefined :: a) ===================================== libraries/ghci/GHCi/TH/Binary.hs ===================================== @@ -9,7 +9,6 @@ module GHCi.TH.Binary () where import Prelude -- See note [Why do we import Prelude here?] import Data.Binary -import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B import GHC.Serialized import qualified GHC.Boot.TH.Syntax as TH @@ -74,8 +73,8 @@ instance Binary TH.DocLoc -- We need Binary TypeRep for serializing annotations instance Binary Serialized where - put (Serialized tyrep wds) = put tyrep >> put (B.pack wds) - get = Serialized <$> get <*> (B.unpack <$> get) + put (Serialized tyrep wds) = put tyrep >> put wds + get = Serialized <$> get <*> get instance Binary TH.Bytes where put (TH.Bytes ptr off sz) = put bs ===================================== testsuite/tests/annotations/should_run/Makefile ===================================== @@ -9,3 +9,7 @@ config : echo "module Config where" >>$(CONFIG_HS) echo "cTop :: String" >> $(CONFIG_HS) echo 'cTop = "$(subst \,\\,$(shell '$(TEST_HC)' --print-libdir))"' >> $(CONFIG_HS) + +T16841: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T16841.hs + '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T16841.hi | grep 'annotated by' ===================================== testsuite/tests/annotations/should_run/T16841.hs ===================================== @@ -0,0 +1,15 @@ +-- | Measures the overhead of serializing annotations of a few types. +module T16841 where + +foo :: Int +foo = 42 + +{-# ANN foo (42 :: Int) #-} +{-# ANN foo (2^100 :: Integer) #-} +{-# ANN foo (3.25 :: Double) #-} +{-# ANN foo 'x' #-} +{-# ANN foo "helloworld" #-} +{-# ANN foo (Just True) #-} +{-# ANN foo ([1..100] :: [Int]) #-} +{-# ANN module (Left 7 :: Either Int String) #-} + ===================================== testsuite/tests/annotations/should_run/T16841.stdout ===================================== @@ -0,0 +1,9 @@ +Module target T16841 annotated by 15 of type Either Int [Char] +Named target foo annotated by 1509 of type [Int] +Named target foo annotated by 18 of type Maybe Bool +Named target foo annotated by 119 of type [Char] +Named target foo annotated by 2 of type Char +Named target foo annotated by 11 of type Double +Named target foo annotated by 24 of type Integer +Named target foo annotated by 6 of type Int + ===================================== testsuite/tests/annotations/should_run/all.T ===================================== @@ -16,6 +16,10 @@ test('annrun01', multimod_compile_and_run, ['annrun01', '-package ghc ' + config.ghc_th_way_flags]) +# Skipping on windows because of platform-specific failures. See +# https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16841#note_706770 +test('T16841', [req_th, windows_skip, extra_files(['T16841.hs'])], makefile_test, ['T16841']) + """" Helpful things to C+P: ===================================== testsuite/tests/codeGen/should_gen_asm/T24813.asm ===================================== @@ -0,0 +1,10 @@ +popcnt8: + movzbl + popcnt + movq + jmp +popcnt16: + movzwl + popcnt + movq + jmp ===================================== testsuite/tests/codeGen/should_gen_asm/T24813.cmm ===================================== @@ -0,0 +1,16 @@ +#include "Cmm.h" + +// Popcount of a zero-extended sub-word value should be a single +// zero-extending load followed by one POPCNT (#24813). + +popcnt8 (W_ p) { + W_ r; + (r) = prim %popcnt8(%zx64(bits8[p])); + return (r); +} + +popcnt16 (W_ p) { + W_ r; + (r) = prim %popcnt16(%zx64(bits16[p])); + return (r); +} ===================================== testsuite/tests/codeGen/should_gen_asm/all.T ===================================== @@ -27,6 +27,7 @@ test('T25233', [unless(arch('x86_64'), skip), when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-O']) test('T25233b', [unless(arch('x86_64'), skip), when(unregisterised(), skip)], compile_grep_asm, ['cmm', True, '']) +test('T24813', is_amd64_codegen, compile_cmp_asm, ['cmm', '-msse4.2']) is_aarch64_codegen = [ unless(arch('aarch64'), skip), when(unregisterised(), skip), ===================================== testsuite/tests/plugins/T26761Plugin.hs ===================================== @@ -7,6 +7,7 @@ import GHC import GHC.Plugins import GHC.Tc.Types import GHC.Tc.Utils.Monad +import qualified Data.ByteString.Short as Short import qualified Data.Map as Map import Data.Word (Word8) import System.IO (hFlush, stdout) @@ -38,5 +39,5 @@ plugin = defaultPlugin { typeCheckResultAction = typecheckPlugin } -- check that it is visible from other modules. let ann = Annotation (ModuleTarget $ tcg_mod gblEnv) - (toSerialized id [0]) + (toSerialized id (Short.pack [0])) return gblEnv { tcg_anns = ann : tcg_anns gblEnv } ===================================== testsuite/tests/plugins/all.T ===================================== @@ -155,7 +155,7 @@ test('T14335', -fexternal-interpreter -package simple-plugin ' + config.plugin_way_flags]) test('T26761', [extra_files(['T26761Plugin.hs', 'T26761a.hs'])], - multimod_compile, ['T26761', '-package ghc ' + config.plugin_way_flags ]) + multimod_compile, ['T26761', '-package ghc -package bytestring ' + config.plugin_way_flags ]) test('plugin-recomp-pure', [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd5348af3799271f693c7331665dd74... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bd5348af3799271f693c7331665dd74... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help