Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

17 changed files:

Changes:

  • changelog.d/T28002
    1 
    +section: compiler
    2 
    +issues: #28002
    3 
    +mrs: !16841
    4 
    +synopsis:
    5 
    +  Use ``ShortByteString`` in the ``Serialized`` type instead of ``[Word8]``
    6 
    +description:
    7 
    +  ``GHC.Serialized.Serialized`` now uses ``ByteString`` to store serialized data.
    8 
    +  This makes in-memory representation more compact.

  • changelog.d/T28002-api
    1 
    +section: ghc-lib
    2 
    +issues: #28002
    3 
    +mrs: !16841
    4 
    +synopsis:
    5 
    +  Use ``ShortByteString`` in the ``Serialized`` type instead of ``[Word8]``
    6 
    +description:
    7 
    +  Breaking change: All functions that previously handled annotations in ``[Word8]``
    8 
    +  form now use ``ShortByteString``. The following definitions have modified types:
    9 
    +  * ``GHC.findGlobalAnns``
    10 
    +  * ``GHC.Tc.Gen.Splice.getAnnotationsByTypeRep``
    11 
    +  * ``GHC.Core.Opt.Monad.getAnnotations``
    12 
    +  * ``GHC.Core.Opt.Monad.getFirstAnnotations``
    13 
    +  * ``GHC.Types.Annotations.deserializeAnns``
    14 
    +  * ``GHC.Types.Annotations.findAnns``
    15 
    +  * ``GHC.Types.Annotations.findAnnsByTypeRep``
    16 
    +  * ``GHC.Serialized.Serialized``
    17 
    +  * ``GHC.Serialized.toSerialized``
    18 
    +  * ``GHC.Serialized.fromSerialized``
    19 
    +  * ``GHC.Serialized.serializeWithData``
    20 
    +  * ``GHC.Serialized.deserializeWithData``
    21 
    +  * ``GHCi.Message.ReifyAnnotations``

  • compiler/GHC.hs
    ... ... @@ -453,12 +453,12 @@ import qualified GHC.Unit.Home.Graph as HUG
    453 453 
     import Control.Applicative ((<|>))
    454 454 
     import Control.Monad
    455 455 
     import Control.Monad.Catch as MC
    456 
    +import Data.ByteString.Short (ShortByteString)
    456 457 
     import Data.Foldable
    457 458 
     import Data.Function ((&))
    458 459 
     import Data.IORef
    459 460 
     import Data.List (isPrefixOf)
    460 461 
     import Data.Typeable    ( Typeable )
    461 
    -import Data.Word        ( Word8 )
    462 462
    463 463 
     import qualified Data.Map.Strict as Map
    464 464 
     import Data.Set (Set)
    ... ... @@ -1526,7 +1526,7 @@ lookupGlobalName :: GhcMonad m => Name -> m (Maybe TyThing)
    1526 1526 
     lookupGlobalName name = withSession $ \hsc_env -> do
    1527 1527 
        liftIO $ lookupType hsc_env name
    1528 1528
    1529 
    -findGlobalAnns :: (GhcMonad m, Typeable a) => ([Word8] -> a) -> AnnTarget Name -> m [a]
    1529 
    +findGlobalAnns :: (GhcMonad m, Typeable a) => (ShortByteString -> a) -> AnnTarget Name -> m [a]
    1530 1530 
     findGlobalAnns deserialize target = withSession $ \hsc_env -> do
    1531 1531 
         ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
    1532 1532 
         return (findAnns deserialize ann_env target)

  • compiler/GHC/Core/Opt/Monad.hs
    ... ... @@ -68,9 +68,9 @@ import GHC.Unit.Module.ModGuts
    68 68 
     import GHC.Unit.External
    69 69
    70 70 
     import Data.Bifunctor ( bimap )
    71 
    +import Data.ByteString.Short ( ShortByteString )
    71 72 
     import Data.Dynamic
    72 73 
     import Data.Maybe (listToMaybe)
    73 
    -import Data.Word
    74 74 
     import Control.Monad
    75 75 
     import Control.Applicative ( Alternative(..) )
    76 76
    ... ... @@ -323,14 +323,14 @@ get_eps = do
    323 323 
     -- annotations.
    324 324 
     --
    325 325 
     -- See Note [Annotations]
    326 
    -getAnnotations :: Typeable a => ([Word8] -> a) -> ModGuts -> CoreM (ModuleEnv [a], NameEnv [a])
    326 
    +getAnnotations :: Typeable a => (ShortByteString -> a) -> ModGuts -> CoreM (ModuleEnv [a], NameEnv [a])
    327 327 
     getAnnotations deserialize guts = do
    328 328 
          hsc_env <- getHscEnv
    329 329 
          ann_env <- liftIO $ prepareAnnotations hsc_env (Just guts)
    330 330 
          return (deserializeAnns deserialize ann_env)
    331 331
    332 332 
     -- | Get at most one annotation of a given type per annotatable item.
    333 
    -getFirstAnnotations :: Typeable a => ([Word8] -> a) -> ModGuts -> CoreM (ModuleEnv a, NameEnv a)
    333 
    +getFirstAnnotations :: Typeable a => (ShortByteString -> a) -> ModGuts -> CoreM (ModuleEnv a, NameEnv a)
    334 334 
     getFirstAnnotations deserialize guts
    335 335 
       = bimap mod name <$> getAnnotations deserialize guts
    336 336 
       where

  • compiler/GHC/Tc/Gen/Splice.hs
    ... ... @@ -155,10 +155,10 @@ import Control.DeepSeq
    155 155 
     import Control.Monad
    156 156 
     import Data.Binary
    157 157 
     import Data.Binary.Get
    158 
    +import Data.ByteString.Short (ShortByteString)
    158 159 
     import Data.Containers.ListUtils ( nubOrd )
    159 160 
     import Data.List ( sortBy )
    160 161 
     import Data.Maybe
    161 
    -import qualified Data.ByteString as B
    162 162 
     import qualified Data.ByteString.Lazy as LB
    163 163 
     import Data.Dynamic  ( fromDynamic, toDyn )
    164 164 
     import qualified Data.IntMap as IntMap
    ... ... @@ -1947,7 +1947,7 @@ handleTHMessage msg = case msg of
    1947 1947 
       ReifyInstances n ts -> wrapTHResult $ runQinTcM $ TH.reifyInstances n ts
    1948 1948 
       ReifyRoles n -> wrapTHResult $ runQinTcM $ TH.reifyRoles n
    1949 1949 
       ReifyAnnotations lookup tyrep ->
    1950 
    -    wrapTHResult $ (map B.pack <$> getAnnotationsByTypeRep lookup tyrep)
    1950 
    +    wrapTHResult $ getAnnotationsByTypeRep lookup tyrep
    1951 1951 
       ReifyModule m -> wrapTHResult $ runQinTcM $ TH.reifyModule m
    1952 1952 
       ReifyConStrictness nm -> wrapTHResult $ runQinTcM $ TH.reifyConStrictness nm
    1953 1953 
       GetPackageRoot -> wrapTHResult $ runQinTcM $ TH.getPackageRoot
    ... ... @@ -1967,7 +1967,7 @@ handleTHMessage msg = case msg of
    1967 1967 
       FailIfErrs -> wrapTHResult failIfErrsM
    1968 1968 
       _ -> panic ("handleTHMessage: unexpected message " ++ show msg)
    1969 1969
    1970 
    -getAnnotationsByTypeRep :: TH.AnnLookup -> TypeRep -> TcM [[Word8]]
    1970 
    +getAnnotationsByTypeRep :: TH.AnnLookup -> TypeRep -> TcM [ShortByteString]
    1971 1971 
     getAnnotationsByTypeRep th_name tyrep
    1972 1972 
       = do { name <- lookupThAnnLookup th_name
    1973 1973 
            ; topEnv <- getTopEnv

  • compiler/GHC/Types/Annotations.hs
    ... ... @@ -27,9 +27,9 @@ import GHC.Utils.Outputable
    27 27 
     import GHC.Serialized
    28 28
    29 29 
     import Control.Monad
    30 
    +import Data.ByteString.Short ( ShortByteString )
    30 31 
     import Data.Maybe
    31 32 
     import Data.Typeable
    32 
    -import Data.Word        ( Word8 )
    33 33 
     import Control.DeepSeq
    34 34
    35 35 
     -- | Represents an annotation after it has been sufficiently desugared from
    ... ... @@ -112,14 +112,14 @@ plusAnnEnv a b =
    112 112 
     -- | Find the annotations attached to the given target as 'Typeable'
    113 113 
     --   values of your choice. If no deserializer is specified,
    114 114 
     --   only transient annotations will be returned.
    115 
    -findAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> CoreAnnTarget -> [a]
    115 
    +findAnns :: Typeable a => (ShortByteString -> a) -> AnnEnv -> CoreAnnTarget -> [a]
    116 116 
     findAnns deserialize env
    117 117 
       = mapMaybe (fromSerialized deserialize) . findAnnPayloads env
    118 118
    119 119 
     -- | Find the annotations attached to the given target as 'Typeable'
    120 120 
     --   values of your choice. If no deserializer is specified,
    121 121 
     --   only transient annotations will be returned.
    122 
    -findAnnsByTypeRep :: AnnEnv -> CoreAnnTarget -> TypeRep -> [[Word8]]
    122 
    +findAnnsByTypeRep :: AnnEnv -> CoreAnnTarget -> TypeRep -> [ShortByteString]
    123 123 
     findAnnsByTypeRep env target tyrep
    124 124 
       = [ ws | Serialized tyrep' ws <- findAnnPayloads env target
    125 125 
         , tyrep' == tyrep ]
    ... ... @@ -134,7 +134,7 @@ findAnnPayloads env target =
    134 134 
     -- | Deserialize all annotations of a given type. This happens lazily, that is
    135 135 
     --   no deserialization will take place until the [a] is actually demanded and
    136 136 
     --   the [a] can also be empty (the UniqFM is not filtered).
    137 
    -deserializeAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> (ModuleEnv [a], NameEnv [a])
    137 
    +deserializeAnns :: Typeable a => (ShortByteString -> a) -> AnnEnv -> (ModuleEnv [a], NameEnv [a])
    138 138 
     deserializeAnns deserialize env
    139 139 
       = ( mapModuleEnv deserAnns (ann_mod_env env)
    140 140 
         , mapNameEnv deserAnns (ann_name_env env)

  • compiler/GHC/Utils/Outputable.hs
    ... ... @@ -138,6 +138,7 @@ import GHC.Utils.Misc (lastMaybe, snocView)
    138 138
    139 139 
     import Data.ByteString (ByteString)
    140 140 
     import qualified Data.ByteString as BS
    141 
    +import qualified Data.ByteString.Short as Short
    141 142 
     import Data.Char
    142 143 
     import qualified Data.Map as M
    143 144 
     import Data.Int
    ... ... @@ -1105,7 +1106,7 @@ instance Outputable a => Outputable (SCC a) where
    1105 1106 
        ppr (CyclicSCC vs) = text "REC" $$ (nest 3 (vcat (map ppr vs)))
    1106 1107
    1107 1108 
     instance Outputable Serialized where
    1108 
    -    ppr (Serialized the_type bytes) = int (length bytes) <+> text "of type" <+> text (show the_type)
    1109 
    +    ppr (Serialized the_type bytes) = int (Short.length bytes) <+> text "of type" <+> text (show the_type)
    1109 1110
    1110 1111 
     instance Outputable Extension where
    1111 1112 
         ppr = text . show

  • libraries/ghc-boot/GHC/Serialized.hs
    ... ... @@ -19,144 +19,68 @@ module GHC.Serialized (
    19 19 
       ) where
    20 20
    21 21 
     import Prelude -- See note [Why do we import Prelude here?]
    22 
    -import Data.Bits
    23 
    -import Data.Word        ( Word8 )
    24 
    -import Data.Data
    25 22 
     import Control.DeepSeq
    23 
    +import Data.Binary
    24 
    +import Data.Binary.Get
    25 
    +import Data.Binary.Put
    26 
    +import Data.ByteString.Short (ShortByteString)
    27 
    +import qualified Data.ByteString.Short as Short
    28 
    +import qualified Data.ByteString.Lazy as ByteString.Lazy
    29 
    +import Data.Data
    26 30
    27 31
    28 32 
     -- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types
    29 
    -data Serialized = Serialized TypeRep [Word8]
    33 
    +data Serialized = Serialized TypeRep ShortByteString
    30 34
    31 35 
     instance NFData Serialized where
    32 36 
       rnf (Serialized tr ws) = rnf tr `seq` rnf ws
    33 37
    34 38 
     -- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later
    35 
    -toSerialized :: forall a. Typeable a => (a -> [Word8]) -> a -> Serialized
    39 
    +toSerialized :: forall a. Typeable a => (a -> ShortByteString) -> a -> Serialized
    36 40 
     toSerialized serialize what = Serialized (typeOf what) (serialize what)
    37 41
    38 42 
     -- | If the 'Serialized' value contains something of the given type, then use the specified deserializer to return @Just@ that.
    39 43 
     -- Otherwise return @Nothing@.
    40 
    -fromSerialized :: forall a. Typeable a => ([Word8] -> a) -> Serialized -> Maybe a
    44 
    +fromSerialized :: forall a. Typeable a => (ShortByteString -> a) -> Serialized -> Maybe a
    41 45 
     fromSerialized deserialize (Serialized the_type bytes)
    42 46 
       | the_type == rep = Just (deserialize bytes)
    43 47 
       | otherwise       = Nothing
    44 48 
       where rep = typeRep (Proxy :: Proxy a)
    45 49
    46 50 
     -- | Use a 'Data' instance to implement a serialization scheme dual to that of 'deserializeWithData'
    47 
    -serializeWithData :: Data a => a -> [Word8]
    48 
    -serializeWithData what = serializeWithData' what []
    49 
    -
    50 
    -serializeWithData' :: Data a => a -> [Word8] -> [Word8]
    51 
    -serializeWithData' what = fst $ gfoldl (\(before, a_to_b) a -> (before . serializeWithData' a, a_to_b a))
    52 
    -                                       (\x -> (serializeConstr (constrRep (toConstr what)), x))
    53 
    -                                       what
    51 
    +serializeWithData :: Data a => a -> ShortByteString
    52 
    +serializeWithData = Short.toShort . ByteString.Lazy.toStrict . runPut . putData
    54 53
    55 54 
     -- | Use a 'Data' instance to implement a deserialization scheme dual to that of 'serializeWithData'
    56 
    -deserializeWithData :: Data a => [Word8] -> a
    57 
    -deserializeWithData = snd . deserializeWithData'
    58 
    -
    59 
    -deserializeWithData' :: forall a. Data a => [Word8] -> ([Word8], a)
    60 
    -deserializeWithData' bytes = deserializeConstr bytes $ \constr_rep bytes ->
    61 
    -                             gunfold (\(bytes, b_to_r) -> let (bytes', b) = deserializeWithData' bytes in (bytes', b_to_r b))
    62 
    -                                     (\x -> (bytes, x))
    63 
    -                                     (repConstr (dataTypeOf (undefined :: a)) constr_rep)
    64 
    -
    65 
    -
    66 
    -serializeConstr :: ConstrRep -> [Word8] -> [Word8]
    67 
    -serializeConstr (AlgConstr ix)   = serializeWord8 1 . serializeInt ix
    68 
    -serializeConstr (IntConstr i)    = serializeWord8 2 . serializeInteger i
    69 
    -serializeConstr (FloatConstr r)  = serializeWord8 3 . serializeRational r
    70 
    -serializeConstr (CharConstr c)   = serializeWord8 4 . serializeChar c
    71 
    -
    72 
    -
    73 
    -deserializeConstr :: [Word8] -> (ConstrRep -> [Word8] -> a) -> a
    74 
    -deserializeConstr bytes k = deserializeWord8 bytes $ \constr_ix bytes ->
    75 
    -                            case constr_ix of
    76 
    -                                1 -> deserializeInt      bytes $ \ix -> k (AlgConstr ix)
    77 
    -                                2 -> deserializeInteger  bytes $ \i  -> k (IntConstr i)
    78 
    -                                3 -> deserializeRational bytes $ \r  -> k (FloatConstr r)
    79 
    -                                4 -> deserializeChar     bytes $ \c  -> k (CharConstr c)
    80 
    -                                x -> error $ "deserializeConstr: unrecognised serialized constructor type " ++ show x ++ " in context " ++ show bytes
    81 
    -
    82 
    -
    83 
    -serializeFixedWidthNum :: forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8]
    84 
    -serializeFixedWidthNum what = go (finiteBitSize what) what
    85 
    -  where
    86 
    -    go :: Int -> a -> [Word8] -> [Word8]
    87 
    -    go size current rest
    88 
    -      | size <= 0 = rest
    89 
    -      | otherwise = fromIntegral (current .&. 255) : go (size - 8) (current `shiftR` 8) rest
    90 
    -
    91 
    -deserializeFixedWidthNum :: forall a b. (Integral a, FiniteBits a) => [Word8] -> (a -> [Word8] -> b) -> b
    92 
    -deserializeFixedWidthNum bytes k = go (finiteBitSize (undefined :: a)) bytes k
    93 
    -  where
    94 
    -    go :: Int -> [Word8] -> (a -> [Word8] -> b) -> b
    95 
    -    go size bytes k
    96 
    -      | size <= 0 = k 0 bytes
    97 
    -      | otherwise = case bytes of
    98 
    -                        (byte:bytes) -> go (size - 8) bytes (\x -> k ((x `shiftL` 8) .|. fromIntegral byte))
    99 
    -                        []           -> error "deserializeFixedWidthNum: unexpected end of stream"
    100 
    -
    101 
    -
    102 
    -serializeEnum :: (Enum a) => a -> [Word8] -> [Word8]
    103 
    -serializeEnum = serializeInt . fromEnum
    104 
    -
    105 
    -deserializeEnum :: Enum a => [Word8] -> (a -> [Word8] -> b) -> b
    106 
    -deserializeEnum bytes k = deserializeInt bytes (k . toEnum)
    107 
    -
    108 
    -
    109 
    -serializeWord8 :: Word8 -> [Word8] -> [Word8]
    110 
    -serializeWord8 x = (x:)
    111 
    -
    112 
    -deserializeWord8 :: [Word8] -> (Word8 -> [Word8] -> a) -> a
    113 
    -deserializeWord8 (byte:bytes) k = k byte bytes
    114 
    -deserializeWord8 []           _ = error "deserializeWord8: unexpected end of stream"
    115 
    -
    116 
    -
    117 
    -serializeInt :: Int -> [Word8] -> [Word8]
    118 
    -serializeInt = serializeFixedWidthNum
    119 
    -
    120 
    -deserializeInt :: [Word8] -> (Int -> [Word8] -> a) -> a
    121 
    -deserializeInt = deserializeFixedWidthNum
    122 
    -
    123 
    -
    124 
    -serializeRational :: (Real a) => a -> [Word8] -> [Word8]
    125 
    -serializeRational = serializeString . show . toRational
    126 
    -
    127 
    -deserializeRational :: (Fractional a) => [Word8] -> (a -> [Word8] -> b) -> b
    128 
    -deserializeRational bytes k = deserializeString bytes (k . fromRational . read)
    129 
    -
    130 
    -
    131 
    -serializeInteger :: Integer -> [Word8] -> [Word8]
    132 
    -serializeInteger = serializeString . show
    133 
    -
    134 
    -deserializeInteger :: [Word8] -> (Integer -> [Word8] -> a) -> a
    135 
    -deserializeInteger bytes k = deserializeString bytes (k . read)
    136 
    -
    137 
    -
    138 
    -serializeChar :: Char -> [Word8] -> [Word8]
    139 
    -serializeChar = serializeString . show
    140 
    -
    141 
    -deserializeChar :: [Word8] -> (Char -> [Word8] -> a) -> a
    142 
    -deserializeChar bytes k = deserializeString bytes (k . read)
    143 
    -
    144 
    -
    145 
    -serializeString :: String -> [Word8] -> [Word8]
    146 
    -serializeString = serializeList serializeEnum
    147 
    -
    148 
    -deserializeString :: [Word8] -> (String -> [Word8] -> a) -> a
    149 
    -deserializeString = deserializeList deserializeEnum
    150 
    -
    151 
    -
    152 
    -serializeList :: (a -> [Word8] -> [Word8]) -> [a] -> [Word8] -> [Word8]
    153 
    -serializeList serialize_element xs = serializeInt (length xs) . foldr (.) id (map serialize_element xs)
    154 
    -
    155 
    -deserializeList :: forall a b. (forall c. [Word8] -> (a -> [Word8] -> c) -> c)
    156 
    -                -> [Word8] -> ([a] -> [Word8] -> b) -> b
    157 
    -deserializeList deserialize_element bytes k = deserializeInt bytes $ \len bytes -> go len bytes k
    158 
    -  where
    159 
    -    go :: Int -> [Word8] -> ([a] -> [Word8] -> b) -> b
    160 
    -    go len bytes k
    161 
    -      | len <= 0  = k [] bytes
    162 
    -      | otherwise = deserialize_element bytes (\elt bytes -> go (len - 1) bytes (k . (elt:)))
    55 
    +deserializeWithData :: Data a => ShortByteString -> a
    56 
    +deserializeWithData bs =
    57 
    +  case runGetOrFail getData (ByteString.Lazy.fromStrict (Short.fromShort bs)) of
    58 
    +    Right (_, _, x)    -> x
    59 
    +    Left (_, off, msg) ->
    60 
    +      error ("deserializeWithData: " ++ msg ++ " at offset " ++ show off)
    61 
    +
    62 
    +putData :: Data a => a -> Put
    63 
    +putData x = do
    64 
    +  putConstrRep (constrRep (toConstr x))
    65 
    +  sequence_ (gmapQ putData x)
    66 
    +
    67 
    +getData :: forall a. Data a => Get a
    68 
    +getData = do
    69 
    +  rep <- getConstrRep
    70 
    +  fromConstrM getData (repConstr (dataTypeOf (undefined :: a)) rep)
    71 
    +
    72 
    +putConstrRep :: ConstrRep -> Put
    73 
    +putConstrRep (AlgConstr ix)  = putWord8 1 >> put ix
    74 
    +putConstrRep (IntConstr i)   = putWord8 2 >> put i
    75 
    +putConstrRep (FloatConstr r) = putWord8 3 >> put r
    76 
    +putConstrRep (CharConstr c)  = putWord8 4 >> put c
    77 
    +
    78 
    +getConstrRep :: Get ConstrRep
    79 
    +getConstrRep = do
    80 
    +  tag <- getWord8
    81 
    +  case tag of
    82 
    +    1 -> AlgConstr   <$> get
    83 
    +    2 -> IntConstr   <$> get
    84 
    +    3 -> FloatConstr <$> get
    85 
    +    4 -> CharConstr  <$> get
    86 
    +    _ -> fail ("unrecognised constructor tag " ++ show tag)

  • libraries/ghci/GHCi/Message.hs
    ... ... @@ -297,7 +297,7 @@ data THMessage a where
    297 297 
       ReifyInstances :: TH.Name -> [TH.Type] -> THMessage (THResult [TH.Dec])
    298 298 
       ReifyRoles :: TH.Name -> THMessage (THResult [TH.Role])
    299 299 
       ReifyAnnotations :: TH.AnnLookup -> TypeRep
    300 
    -    -> THMessage (THResult [ByteString])
    300 
    +    -> THMessage (THResult [BS.ShortByteString])
    301 301 
       ReifyModule :: TH.Module -> THMessage (THResult TH.ModuleInfo)
    302 302 
       ReifyConStrictness :: TH.Name -> THMessage (THResult [TH.DecidedStrictness])
    303 303

  • libraries/ghci/GHCi/TH.hs
    ... ... @@ -100,7 +100,6 @@ import Control.Monad.IO.Class (MonadIO (..))
    100 100 
     import Data.Binary
    101 101 
     import Data.Binary.Put
    102 102 
     import Data.ByteString (ByteString)
    103 
    -import qualified Data.ByteString as B
    104 103 
     import qualified Data.ByteString.Lazy as LB
    105 104 
     import Data.Data
    106 105 
     import Data.Dynamic
    ... ... @@ -169,7 +168,7 @@ instance MonadIO GHCiQ where
    169 168 
       -- serialize irrelevant annotations.
    170 169 
     reifyAnnotations :: forall a . Data a => TH.AnnLookup -> GHCiQ [a]
    171 170 
     reifyAnnotations lookup =
    172 
    -    map (deserializeWithData . B.unpack) <$>
    171 
    +    map deserializeWithData <$>
    173 172 
           ghcCmd (ReifyAnnotations lookup typerep)
    174 173 
         where typerep = typeOf (undefined :: a)
    175 174

  • libraries/ghci/GHCi/TH/Binary.hs
    ... ... @@ -9,7 +9,6 @@ module GHCi.TH.Binary () where
    9 9
    10 10 
     import Prelude -- See note [Why do we import Prelude here?]
    11 11 
     import Data.Binary
    12 
    -import qualified Data.ByteString as B
    13 12 
     import qualified Data.ByteString.Internal as B
    14 13 
     import GHC.Serialized
    15 14 
     import qualified GHC.Boot.TH.Syntax as TH
    ... ... @@ -74,8 +73,8 @@ instance Binary TH.DocLoc
    74 73 
     -- We need Binary TypeRep for serializing annotations
    75 74
    76 75 
     instance Binary Serialized where
    77 
    -    put (Serialized tyrep wds) = put tyrep >> put (B.pack wds)
    78 
    -    get = Serialized <$> get <*> (B.unpack <$> get)
    76 
    +    put (Serialized tyrep wds) = put tyrep >> put wds
    77 
    +    get = Serialized <$> get <*> get
    79 78
    80 79 
     instance Binary TH.Bytes where
    81 80 
        put (TH.Bytes ptr off sz) = put bs

  • testsuite/tests/annotations/should_run/Makefile
    ... ... @@ -9,3 +9,7 @@ config :
    9 9 
     	echo "module Config where" >>$(CONFIG_HS)
    10 10 
     	echo "cTop          :: String" >> $(CONFIG_HS)
    11 11 
     	echo 'cTop          = "$(subst \,\\,$(shell '$(TEST_HC)' --print-libdir))"' >> $(CONFIG_HS)
    12 
    +
    13 
    +T16841:
    14 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T16841.hs
    15 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) --show-iface T16841.hi | grep 'annotated by'

  • testsuite/tests/annotations/should_run/T16841.hs
    1 
    +-- | Measures the overhead of serializing annotations of a few types.
    2 
    +module T16841 where
    3 
    +
    4 
    +foo :: Int
    5 
    +foo = 42
    6 
    +
    7 
    +{-# ANN foo (42 :: Int) #-}
    8 
    +{-# ANN foo (2^100 :: Integer) #-}
    9 
    +{-# ANN foo (3.25 :: Double) #-}
    10 
    +{-# ANN foo 'x' #-}
    11 
    +{-# ANN foo "helloworld" #-}
    12 
    +{-# ANN foo (Just True) #-}
    13 
    +{-# ANN foo ([1..100] :: [Int]) #-}
    14 
    +{-# ANN module (Left 7 :: Either Int String) #-}
    15 
    +

  • testsuite/tests/annotations/should_run/T16841.stdout
    1 
    +Module target T16841 annotated by 15 of type Either Int [Char]
    2 
    +Named target foo annotated by 1509 of type [Int]
    3 
    +Named target foo annotated by 18 of type Maybe Bool
    4 
    +Named target foo annotated by 119 of type [Char]
    5 
    +Named target foo annotated by 2 of type Char
    6 
    +Named target foo annotated by 11 of type Double
    7 
    +Named target foo annotated by 24 of type Integer
    8 
    +Named target foo annotated by 6 of type Int
    9 
    +

  • testsuite/tests/annotations/should_run/all.T
    ... ... @@ -16,6 +16,10 @@ test('annrun01',
    16 16 
          multimod_compile_and_run,
    17 17 
          ['annrun01', '-package ghc ' + config.ghc_th_way_flags])
    18 18
    19 
    +# Skipping on windows because of platform-specific failures.  See
    20 
    +# https://gitlab.haskell.org/ghc/ghc/-/merge_requests/16841#note_706770
    21 
    +test('T16841', [req_th, windows_skip, extra_files(['T16841.hs'])], makefile_test, ['T16841'])
    22 
    +
    19 23 
     """"
    20 24 
     Helpful things to C+P:
    21 25

  • testsuite/tests/plugins/T26761Plugin.hs
    ... ... @@ -7,6 +7,7 @@ import GHC
    7 7 
     import GHC.Plugins
    8 8 
     import GHC.Tc.Types
    9 9 
     import GHC.Tc.Utils.Monad
    10 
    +import qualified Data.ByteString.Short as Short
    10 11 
     import qualified Data.Map as Map
    11 12 
     import Data.Word (Word8)
    12 13 
     import System.IO (hFlush, stdout)
    ... ... @@ -38,5 +39,5 @@ plugin = defaultPlugin { typeCheckResultAction = typecheckPlugin }
    38 39 
           -- check that it is visible from other modules.
    39 40 
           let ann = Annotation
    40 41 
                       (ModuleTarget $ tcg_mod gblEnv)
    41 
    -                  (toSerialized id [0])
    42 
    +                  (toSerialized id (Short.pack [0]))
    42 43 
           return gblEnv { tcg_anns = ann : tcg_anns gblEnv }

  • testsuite/tests/plugins/all.T
    ... ... @@ -155,7 +155,7 @@ test('T14335',
    155 155 
            -fexternal-interpreter -package simple-plugin ' + config.plugin_way_flags])
    156 156
    157 157 
     test('T26761', [extra_files(['T26761Plugin.hs', 'T26761a.hs'])],
    158 
    -     multimod_compile, ['T26761', '-package ghc ' + config.plugin_way_flags ])
    158 
    +     multimod_compile, ['T26761', '-package ghc -package bytestring ' + config.plugin_way_flags ])
    159 159
    160 160 
     test('plugin-recomp-pure',
    161 161 
          [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']),

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/5308737363a0e87d5e5cbaad774c6feb4f816cfc at 1793177192