Cheng Shao pushed to branch wip/bytecode-serialize-3 at Glasgow Haskell Compiler / GHC

Commits:

13 changed files:

Changes:

  • compiler/GHC/Builtin/PrimOps.hs
    ... ... @@ -53,10 +53,12 @@ import GHC.Types.Unique ( Unique )
    53 53
    54 54 
     import GHC.Unit.Types    ( Unit )
    55 55
    56 
    +import GHC.Utils.Binary
    56 57 
     import GHC.Utils.Outputable
    57 58 
     import GHC.Utils.Panic
    58 59
    59 60 
     import GHC.Data.FastString
    61 
    +import GHC.Data.SmallArray
    60 62
    61 63 
     {-
    62 64 
     ************************************************************************
    ... ... @@ -929,3 +931,12 @@ primOpIsReallyInline = \case
    929 931 
       DataToTagSmallOp -> False
    930 932 
       DataToTagLargeOp -> False
    931 933 
       p                -> not (primOpOutOfLine p)
    934 
    +
    935 
    +instance Binary PrimOp where
    936 
    +  get bh = (allThePrimOpsArr `indexSmallArray`) <$> get bh
    937 
    +
    938 
    +  put_ bh = put_ bh . primOpTag
    939 
    +
    940 
    +allThePrimOpsArr :: SmallArray PrimOp
    941 
    +{-# NOINLINE allThePrimOpsArr #-}
    942 
    +allThePrimOpsArr = listToArray (maxPrimOpTag + 1) primOpTag id allThePrimOps

  • compiler/GHC/ByteCode/Breakpoints.hs
    1 1 
     {-# LANGUAGE RecordWildCards #-}
    2 2 
     {-# LANGUAGE DerivingStrategies #-}
    3 
    +{-# LANGUAGE DerivingVia #-}
    3 4
    4 5 
     -- | Breakpoint information constructed during ByteCode generation.
    5 6 
     --
    ... ... @@ -44,6 +45,7 @@ import GHC.HsToCore.Breakpoints
    44 45 
     import GHC.Iface.Syntax
    45 46
    46 47 
     import GHC.Unit.Module (Module)
    48 
    +import GHC.Utils.Binary
    47 49 
     import GHC.Utils.Outputable
    48 50 
     import GHC.Utils.Panic
    49 51 
     import Data.Array
    ... ... @@ -297,3 +299,26 @@ instance Outputable CgBreakInfo where
    297 299 
                   parens (ppr (cgb_vars info) <+>
    298 300 
                           ppr (cgb_resty info) <+>
    299 301 
                           ppr (cgb_tick_id info))
    302 
    +
    303 
    +instance Binary CgBreakInfo where
    304 
    +  put_ bh CgBreakInfo {..} =
    305 
    +    put_ bh cgb_tyvars
    306 
    +      *> put_ bh cgb_vars
    307 
    +      *> put_ bh cgb_resty
    308 
    +      *> put_ bh cgb_tick_id
    309 
    +
    310 
    +  get bh = CgBreakInfo <$> get bh <*> get bh <*> get bh <*> get bh
    311 
    +
    312 
    +instance Binary InternalModBreaks where
    313 
    +  get bh = InternalModBreaks <$> get bh <*> get bh
    314 
    +
    315 
    +  put_ bh InternalModBreaks {..} =
    316 
    +    put_ bh imodBreaks_breakInfo *> put_ bh imodBreaks_modBreaks
    317 
    +
    318 
    +deriving via BreakpointId instance Binary InternalBreakLoc
    319 
    +
    320 
    +instance Binary InternalBreakpointId where
    321 
    +  get bh = InternalBreakpointId <$> get bh <*> get bh
    322 
    +
    323 
    +  put_ bh InternalBreakpointId {..} =
    324 
    +    put_ bh ibi_info_mod *> put_ bh ibi_info_index

  • compiler/GHC/ByteCode/Serialize.hs
    1 
    +{-# LANGUAGE MultiWayIf #-}
    2 
    +{-# LANGUAGE RecordWildCards #-}
    3 
    +{-# OPTIONS_GHC -Wno-orphans #-}
    4 
    +
    5 
    +module GHC.ByteCode.Serialize
    6 
    +  ( testBinByteCode,
    7 
    +  )
    8 
    +where
    9 
    +
    10 
    +import Control.Monad
    11 
    +import Data.Binary qualified as Binary
    12 
    +import Data.Foldable
    13 
    +import Data.IORef
    14 
    +import Data.Proxy
    15 
    +import Data.Word
    16 
    +import GHC.ByteCode.Types
    17 
    +import GHC.Data.FastString
    18 
    +import GHC.Driver.Env
    19 
    +import GHC.Iface.Binary
    20 
    +import GHC.Prelude
    21 
    +import GHC.Types.Name
    22 
    +import GHC.Types.Name.Cache
    23 
    +import GHC.Types.SrcLoc
    24 
    +import GHC.Utils.Binary
    25 
    +import GHC.Utils.Exception
    26 
    +import GHC.Utils.TmpFs
    27 
    +import System.FilePath
    28 
    +
    29 
    +testBinByteCode :: HscEnv -> CompiledByteCode -> IO CompiledByteCode
    30 
    +testBinByteCode hsc_env cbc = withSystemTempDirectory "ghc-bbc" $ \tmpdir -> do
    31 
    +  let f = tmpdir </> "ghc-bbc"
    32 
    +  roundtripBinByteCode hsc_env f cbc
    33 
    +
    34 
    +roundtripBinByteCode ::
    35 
    +  HscEnv -> FilePath -> CompiledByteCode -> IO CompiledByteCode
    36 
    +roundtripBinByteCode hsc_env f cbc = do
    37 
    +  writeBinByteCode f cbc
    38 
    +  readBinByteCode hsc_env f
    39 
    +
    40 
    +readBinByteCode :: HscEnv -> FilePath -> IO CompiledByteCode
    41 
    +readBinByteCode hsc_env f = do
    42 
    +  bh' <- readBinMem f
    43 
    +  bh <- addSerializableNameReader hsc_env bh'
    44 
    +  getWithUserData (hsc_NC hsc_env) bh
    45 
    +
    46 
    +writeBinByteCode :: FilePath -> CompiledByteCode -> IO ()
    47 
    +writeBinByteCode f cbc = do
    48 
    +  bh' <- openBinMem (1024 * 1024)
    49 
    +  bh <- addSerializableNameWriter bh'
    50 
    +  putWithUserData QuietBinIFace NormalCompression bh cbc
    51 
    +  writeBinMem bh f
    52 
    +
    53 
    +instance Binary CompiledByteCode where
    54 
    +  get bh = do
    55 
    +    bc_bcos <- get bh
    56 
    +    bc_itbls_len <- get bh
    57 
    +    bc_itbls <- replicateM bc_itbls_len $ do
    58 
    +      nm <- getViaSerializableName bh
    59 
    +      itbl <- get bh
    60 
    +      pure (nm, itbl)
    61 
    +    bc_strs_len <- get bh
    62 
    +    bc_strs <-
    63 
    +      replicateM bc_strs_len $ (,) <$> getViaSerializableName bh <*> get bh
    64 
    +    bc_breaks <- get bh
    65 
    +    bc_spt_entries <- get bh
    66 
    +    evaluate
    67 
    +      CompiledByteCode
    68 
    +        { bc_bcos,
    69 
    +          bc_itbls,
    70 
    +          bc_strs,
    71 
    +          bc_breaks,
    72 
    +          bc_spt_entries
    73 
    +        }
    74 
    +
    75 
    +  put_ bh CompiledByteCode {..} = do
    76 
    +    put_ bh bc_bcos
    77 
    +    put_ bh $ length bc_itbls
    78 
    +    for_ bc_itbls $ \(nm, itbl) -> do
    79 
    +      putViaSerializableName bh nm
    80 
    +      put_ bh itbl
    81 
    +    put_ bh $ length bc_strs
    82 
    +    for_ bc_strs $ \(nm, str) -> putViaSerializableName bh nm *> put_ bh str
    83 
    +    put_ bh bc_breaks
    84 
    +    put_ bh bc_spt_entries
    85 
    +
    86 
    +instance Binary UnlinkedBCO where
    87 
    +  get bh =
    88 
    +    UnlinkedBCO
    89 
    +      <$> getViaSerializableName bh
    90 
    +      <*> get bh
    91 
    +      <*> (Binary.decode <$> get bh)
    92 
    +      <*> (Binary.decode <$> get bh)
    93 
    +      <*> get bh
    94 
    +      <*> get bh
    95 
    +
    96 
    +  put_ bh UnlinkedBCO {..} = do
    97 
    +    putViaSerializableName bh unlinkedBCOName
    98 
    +    put_ bh unlinkedBCOArity
    99 
    +    put_ bh $ Binary.encode unlinkedBCOInstrs
    100 
    +    put_ bh $ Binary.encode unlinkedBCOBitmap
    101 
    +    put_ bh unlinkedBCOLits
    102 
    +    put_ bh unlinkedBCOPtrs
    103 
    +
    104 
    +instance Binary BCOPtr where
    105 
    +  get bh = do
    106 
    +    t <- getByte bh
    107 
    +    case t of
    108 
    +      0 -> BCOPtrName <$> getViaSerializableName bh
    109 
    +      1 -> BCOPtrPrimOp <$> get bh
    110 
    +      2 -> BCOPtrBCO <$> get bh
    111 
    +      _ -> BCOPtrBreakArray <$> get bh
    112 
    +
    113 
    +  put_ bh ptr = case ptr of
    114 
    +    BCOPtrName nm -> putByte bh 0 *> putViaSerializableName bh nm
    115 
    +    BCOPtrPrimOp op -> putByte bh 1 *> put_ bh op
    116 
    +    BCOPtrBCO bco -> putByte bh 2 *> put_ bh bco
    117 
    +    BCOPtrBreakArray info_mod -> putByte bh 3 *> put_ bh info_mod
    118 
    +
    119 
    +instance Binary BCONPtr where
    120 
    +  get bh = do
    121 
    +    t <- getByte bh
    122 
    +    case t of
    123 
    +      0 -> BCONPtrWord . fromIntegral <$> (get bh :: IO Word64)
    124 
    +      1 -> BCONPtrLbl <$> get bh
    125 
    +      2 -> BCONPtrItbl <$> getViaSerializableName bh
    126 
    +      3 -> BCONPtrAddr <$> getViaSerializableName bh
    127 
    +      4 -> BCONPtrStr <$> get bh
    128 
    +      5 -> BCONPtrFS <$> get bh
    129 
    +      6 -> BCONPtrFFIInfo <$> get bh
    130 
    +      _ -> BCONPtrCostCentre <$> get bh
    131 
    +
    132 
    +  put_ bh ptr = case ptr of
    133 
    +    BCONPtrWord lit -> putByte bh 0 *> put_ bh (fromIntegral lit :: Word64)
    134 
    +    BCONPtrLbl sym -> putByte bh 1 *> put_ bh sym
    135 
    +    BCONPtrItbl nm -> putByte bh 2 *> putViaSerializableName bh nm
    136 
    +    BCONPtrAddr nm -> putByte bh 3 *> putViaSerializableName bh nm
    137 
    +    BCONPtrStr str -> putByte bh 4 *> put_ bh str
    138 
    +    BCONPtrFS fs -> putByte bh 5 *> put_ bh fs
    139 
    +    BCONPtrFFIInfo ffi -> putByte bh 6 *> put_ bh ffi
    140 
    +    BCONPtrCostCentre ibi -> putByte bh 7 *> put_ bh ibi
    141 
    +
    142 
    +newtype SerializableName = SerializableName {unSerializableName :: Name}
    143 
    +
    144 
    +getViaSerializableName :: ReadBinHandle -> IO Name
    145 
    +getViaSerializableName bh = case findUserDataReader Proxy bh of
    146 
    +  BinaryReader f -> unSerializableName <$> f bh
    147 
    +
    148 
    +putViaSerializableName :: WriteBinHandle -> Name -> IO ()
    149 
    +putViaSerializableName bh nm = case findUserDataWriter Proxy bh of
    150 
    +  BinaryWriter f -> f bh $ SerializableName nm
    151 
    +
    152 
    +addSerializableNameWriter :: WriteBinHandle -> IO WriteBinHandle
    153 
    +addSerializableNameWriter bh' =
    154 
    +  evaluate
    155 
    +    $ flip addWriterToUserData bh'
    156 
    +    $ BinaryWriter
    157 
    +    $ \bh (SerializableName nm) ->
    158 
    +      if
    159 
    +        | isExternalName nm -> do
    160 
    +            putByte bh 0
    161 
    +            put_ bh nm
    162 
    +        | otherwise -> do
    163 
    +            putByte bh 1
    164 
    +            put_ bh
    165 
    +              $ occNameFS (occName nm)
    166 
    +              `appendFS` mkFastString
    167 
    +                (show $ nameUnique nm)
    168 
    +
    169 
    +addSerializableNameReader :: HscEnv -> ReadBinHandle -> IO ReadBinHandle
    170 
    +addSerializableNameReader HscEnv {..} bh' = do
    171 
    +  nc <- evaluate hsc_NC
    172 
    +  env_ref <- newIORef emptyOccEnv
    173 
    +  evaluate $ flip addReaderToUserData bh' $ BinaryReader $ \bh -> do
    174 
    +    t <- getByte bh
    175 
    +    case t of
    176 
    +      0 -> do
    177 
    +        nm <- get bh
    178 
    +        evaluate $ SerializableName nm
    179 
    +      _ -> do
    180 
    +        occ <- mkVarOccFS <$> get bh
    181 
    +        u <- takeUniqFromNameCache nc
    182 
    +        nm' <- evaluate $ mkInternalName u occ noSrcSpan
    183 
    +        fmap SerializableName $ atomicModifyIORef' env_ref $ \env ->
    184 
    +          case lookupOccEnv env occ of
    185 
    +            Just nm -> (env, nm)
    186 
    +            _ -> (extendOccEnv env occ nm', nm')

  • compiler/GHC/ByteCode/Types.hs
    ... ... @@ -35,6 +35,7 @@ import GHC.Data.FastString
    35 35 
     import GHC.Data.FlatBag
    36 36 
     import GHC.Types.Name
    37 37 
     import GHC.Types.Name.Env
    38 
    +import GHC.Utils.Binary
    38 39 
     import GHC.Utils.Outputable
    39 40 
     import GHC.Builtin.PrimOps
    40 41 
     import GHC.Types.SptEntry
    ... ... @@ -296,3 +297,8 @@ instance Outputable UnlinkedBCO where
    296 297 
                  ppr (sizeFlatBag lits), text "lits",
    297 298 
                  ppr (sizeFlatBag ptrs), text "ptrs" ]
    298 299
    300 
    +instance Binary FFIInfo where
    301 
    +  get bh = FFIInfo <$> get bh <*> get bh
    302 
    +
    303 
    +  put_ bh FFIInfo {..} = put_ bh ffiInfoArgs *> put_ bh ffiInfoRet
    304 
    +

  • compiler/GHC/Data/FlatBag.hs
    ... ... @@ -16,6 +16,8 @@ import GHC.Prelude
    16 16 
     import Control.DeepSeq
    17 17
    18 18 
     import GHC.Data.SmallArray
    19 
    +import GHC.Utils.Binary
    20 
    +import GHC.Utils.Exception
    19 21
    20 22 
     -- | Store elements in a flattened representation.
    21 23 
     --
    ... ... @@ -66,6 +68,13 @@ instance NFData a => NFData (FlatBag a) where
    66 68 
       rnf (TupleFlatBag a b) = rnf a `seq` rnf b
    67 69 
       rnf (FlatBag arr) = rnfSmallArray arr
    68 70
    71 
    +instance (Binary a) => Binary (FlatBag a) where
    72 
    +  get bh = do
    73 
    +    xs <- get bh
    74 
    +    evaluate $ fromList (fromIntegral $ length xs) xs
    75 
    +
    76 
    +  put_ bh = put_ bh . elemsFlatBag
    77 
    +
    69 78 
     -- | Create an empty 'FlatBag'.
    70 79 
     --
    71 80 
     -- The empty 'FlatBag' is shared over all instances.
    ... ... @@ -129,4 +138,3 @@ fromSmallArray s = case sizeofSmallArray s of
    129 138 
                           1 -> UnitFlatBag (indexSmallArray s 0)
    130 139 
                           2 -> TupleFlatBag (indexSmallArray s 0) (indexSmallArray s 1)
    131 140 
                           _ -> FlatBag s
    132 
    -

  • compiler/GHC/Driver/Main.hs
    ... ... @@ -305,6 +305,8 @@ import Data.Bifunctor
    305 305 
     import qualified GHC.Unit.Home.Graph as HUG
    306 306 
     import GHC.Unit.Home.PackageTable
    307 307
    308 
    +import GHC.ByteCode.Serialize
    309 
    +
    308 310 
     {- **********************************************************************
    309 311 
     %*                                                                      *
    310 312 
                     Initialisation
    ... ... @@ -2169,7 +2171,8 @@ generateByteCode :: HscEnv
    2169 2171 
       -> ModLocation
    2170 2172 
       -> IO (CompiledByteCode, [FilePath])
    2171 2173 
     generateByteCode hsc_env cgguts mod_location = do
    2172 
    -  (hasStub, comp_bc) <- hscInteractive hsc_env cgguts mod_location
    2174 
    +  (hasStub, comp_bc') <- hscInteractive hsc_env cgguts mod_location
    2175 
    +  comp_bc <- testBinByteCode hsc_env comp_bc'
    2173 2176 
       compile_for_interpreter hsc_env $ \ i_env -> do
    2174 2177 
         stub_o <- traverse (compileForeign i_env LangC) hasStub
    2175 2178 
         foreign_files_o <- traverse (uncurry (compileForeign i_env)) (cgi_foreign_files cgguts)

  • compiler/GHC/HsToCore/Breakpoints.hs
    ... ... @@ -30,6 +30,7 @@ import GHC.Types.SrcLoc (SrcSpan)
    30 30 
     import GHC.Types.Name (OccName)
    31 31 
     import GHC.Types.Tickish (BreakTickIndex, BreakpointId(..))
    32 32 
     import GHC.Unit.Module (Module)
    33 
    +import GHC.Utils.Binary
    33 34 
     import GHC.Utils.Outputable
    34 35 
     import Data.List (intersperse)
    35 36
    ... ... @@ -106,3 +107,13 @@ The breakpoint is in the function called "baz" that is declared in a `let`
    106 107 
     or `where` clause of a declaration called "bar", which itself is declared
    107 108 
     in a `let` or `where` clause of the top-level function called "foo".
    108 109 
     -}
    110 
    +
    111 
    +instance Binary ModBreaks where
    112 
    +  get bh = ModBreaks <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh
    113 
    +
    114 
    +  put_ bh ModBreaks {..} =
    115 
    +    put_ bh modBreaks_locs
    116 
    +      *> put_ bh modBreaks_vars
    117 
    +      *> put_ bh modBreaks_decls
    118 
    +      *> put_ bh modBreaks_ccs
    119 
    +      *> put_ bh modBreaks_module

  • compiler/GHC/Types/SptEntry.hs
    ... ... @@ -3,8 +3,12 @@ module GHC.Types.SptEntry
    3 3 
       )
    4 4 
     where
    5 5
    6 
    -import GHC.Types.Var           ( Id )
    6 
    +import GHC.Builtin.Types
    7 
    +import GHC.Types.Id
    8 
    +import GHC.Types.Name
    7 9 
     import GHC.Fingerprint.Type    ( Fingerprint )
    10 
    +import GHC.Prelude
    11 
    +import GHC.Utils.Binary
    8 12 
     import GHC.Utils.Outputable
    9 13
    10 14 
     -- | An entry to be inserted into a module's static pointer table.
    ... ... @@ -14,3 +18,11 @@ data SptEntry = SptEntry Id Fingerprint
    14 18 
     instance Outputable SptEntry where
    15 19 
       ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr
    16 20
    21 
    +instance Binary SptEntry where
    22 
    +  get bh = do
    23 
    +    nm <- get bh
    24 
    +    fp <- get bh
    25 
    +    pure $ SptEntry (mkVanillaGlobal nm anyTy) fp
    26 
    +
    27 
    +  put_ bh (SptEntry nm fp) =
    28 
    +    put_ bh (getName nm) *> put_ bh fp

  • compiler/GHC/Types/Tickish.hs
    ... ... @@ -4,6 +4,7 @@
    4 4 
     {-# LANGUAGE StandaloneDeriving #-}
    5 5 
     {-# LANGUAGE FlexibleContexts #-}
    6 6 
     {-# LANGUAGE FlexibleInstances #-}
    7 
    +{-# LANGUAGE RecordWildCards #-}
    7 8
    8 9 
     module GHC.Types.Tickish (
    9 10 
       GenTickish(..),
    ... ... @@ -44,6 +45,7 @@ import GHC.Utils.Panic
    44 45 
     import Language.Haskell.Syntax.Extension ( NoExtField )
    45 46
    46 47 
     import Data.Data
    48 
    +import GHC.Utils.Binary
    47 49 
     import GHC.Utils.Outputable (Outputable (ppr), text, (<+>))
    48 50
    49 51 
     {- *********************************************************************
    ... ... @@ -202,6 +204,11 @@ instance NFData BreakpointId where
    202 204 
       rnf BreakpointId{bi_tick_mod, bi_tick_index} =
    203 205 
         rnf bi_tick_mod `seq` rnf bi_tick_index
    204 206
    207 
    +instance Binary BreakpointId where
    208 
    +  get bh = BreakpointId <$> get bh <*> get bh
    209 
    +
    210 
    +  put_ bh BreakpointId {..} = put_ bh bi_tick_mod *> put_ bh bi_tick_index
    211 
    +
    205 212 
     --------------------------------------------------------------------------------
    206 213
    207 214 
     -- | A "counting tick" (where tickishCounts is True) is one that

  • compiler/GHC/Utils/Binary.hs
    ... ... @@ -125,6 +125,7 @@ import Language.Haskell.Syntax.ImpExp.IsBoot (IsBootInterface(..))
    125 125 
     import {-# SOURCE #-} GHC.Types.Name (Name)
    126 126 
     import GHC.Data.FastString
    127 127 
     import GHC.Data.TrieMap
    128 
    +import GHC.Utils.Exception
    128 129 
     import GHC.Utils.Panic.Plain
    129 130 
     import GHC.Types.Unique.FM
    130 131 
     import GHC.Data.FastMutInt
    ... ... @@ -133,6 +134,8 @@ import GHC.Types.SrcLoc
    133 134 
     import GHC.Types.Unique
    134 135 
     import qualified GHC.Data.Strict as Strict
    135 136 
     import GHC.Utils.Outputable( JoinPointHood(..) )
    137 
    +import GHCi.FFI
    138 
    +import GHCi.Message
    136 139
    137 140 
     import Control.DeepSeq
    138 141 
     import Control.Monad            ( when, (<$!>), unless, forM_, void )
    ... ... @@ -140,8 +143,10 @@ import Foreign hiding (bit, setBit, clearBit, shiftL, shiftR, void)
    140 143 
     import Data.Array
    141 144 
     import Data.Array.IO
    142 145 
     import Data.Array.Unsafe
    146 
    +import qualified Data.Binary as Binary
    143 147 
     import Data.ByteString (ByteString, copy)
    144 148 
     import Data.Coerce
    149 
    +import qualified Data.ByteString.Lazy as LBS
    145 150 
     import qualified Data.ByteString.Internal as BS
    146 151 
     import qualified Data.ByteString.Unsafe   as BS
    147 152 
     import qualified Data.ByteString.Short.Internal as SBS
    ... ... @@ -929,6 +934,12 @@ instance Binary Char where
    929 934 
         put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)
    930 935 
         get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))
    931 936
    937 
    +instance Binary Word where
    938 
    +    put_ bh i = put_ bh (fromIntegral i :: Word64)
    939 
    +    get  bh = do
    940 
    +        x <- get bh
    941 
    +        return $! (fromIntegral (x :: Word64))
    942 
    +
    932 943 
     instance Binary Int where
    933 944 
         put_ bh i = put_ bh (fromIntegral i :: Int64)
    934 945 
         get  bh = do
    ... ... @@ -1849,6 +1860,18 @@ instance Binary ByteString where
    1849 1860 
       put_ bh f = putBS bh f
    1850 1861 
       get bh = getBS bh
    1851 1862
    1863 
    +instance Binary LBS.ByteString where
    1864 
    +  put_ bh lbs = do
    1865 
    +    put_ bh (fromIntegral (LBS.length lbs) :: Int)
    1866 
    +    let f bs acc =
    1867 
    +          ( BS.unsafeUseAsCStringLen bs $
    1868 
    +              \(ptr, l) -> putPrim bh l $ \op -> copyBytes op (castPtr ptr) l
    1869 
    +          )
    1870 
    +            *> acc
    1871 
    +    LBS.foldrChunks f (pure ()) lbs
    1872 
    +
    1873 
    +  get bh = LBS.fromStrict <$> get bh
    1874 
    +
    1852 1875 
     instance Binary FastString where
    1853 1876 
       put_ bh f =
    1854 1877 
         case findUserDataWriter (Proxy :: Proxy FastString) bh of
    ... ... @@ -2106,6 +2129,7 @@ instance Binary BinSrcSpan where
    2106 2129 
                 _ -> do s <- get bh
    2107 2130 
                         return $ BinSrcSpan (UnhelpfulSpan s)
    2108 2131
    2132 
    +deriving via BinSrcSpan instance Binary SrcSpan
    2109 2133
    2110 2134 
     {-
    2111 2135 
     Note [Source Location Wrappers]
    ... ... @@ -2163,3 +2187,40 @@ instance Binary a => Binary (FingerprintWithValue a) where
    2163 2187 
     instance NFData a => NFData (FingerprintWithValue a) where
    2164 2188 
       rnf (FingerprintWithValue fp mflags)
    2165 2189 
         = rnf fp `seq` rnf mflags `seq` ()
    2190 
    +
    2191 
    +instance Binary ConInfoTable where
    2192 
    +  get bh = Binary.decode <$> get bh
    2193 
    +
    2194 
    +  put_ bh = put_ bh . Binary.encode
    2195 
    +
    2196 
    +instance Binary FFIType where
    2197 
    +  get bh = do
    2198 
    +    t <- getByte bh
    2199 
    +    evaluate $ case t of
    2200 
    +      0 -> FFIVoid
    2201 
    +      1 -> FFIPointer
    2202 
    +      2 -> FFIFloat
    2203 
    +      3 -> FFIDouble
    2204 
    +      4 -> FFISInt8
    2205 
    +      5 -> FFISInt16
    2206 
    +      6 -> FFISInt32
    2207 
    +      7 -> FFISInt64
    2208 
    +      8 -> FFIUInt8
    2209 
    +      9 -> FFIUInt16
    2210 
    +      10 -> FFIUInt32
    2211 
    +      11 -> FFIUInt64
    2212 
    +      _ -> panic "Binary FFIType: invalid byte"
    2213 
    +
    2214 
    +  put_ bh t = putByte bh $ case t of
    2215 
    +    FFIVoid -> 0
    2216 
    +    FFIPointer -> 1
    2217 
    +    FFIFloat -> 2
    2218 
    +    FFIDouble -> 3
    2219 
    +    FFISInt8 -> 4
    2220 
    +    FFISInt16 -> 5
    2221 
    +    FFISInt32 -> 6
    2222 
    +    FFISInt64 -> 7
    2223 
    +    FFIUInt8 -> 8
    2224 
    +    FFIUInt16 -> 9
    2225 
    +    FFIUInt32 -> 10
    2226 
    +    FFIUInt64 -> 11

  • compiler/ghc.cabal.in
    ... ... @@ -228,6 +228,7 @@ Library
    228 228 
             GHC.ByteCode.InfoTable
    229 229 
             GHC.ByteCode.Instr
    230 230 
             GHC.ByteCode.Linker
    231 
    +        GHC.ByteCode.Serialize
    231 232 
             GHC.ByteCode.Types
    232 233 
             GHC.Cmm
    233 234 
             GHC.Cmm.BlockId

  • testsuite/tests/count-deps/CountDepsAst.stdout
    ... ... @@ -71,6 +71,7 @@ GHC.Data.Maybe
    71 71 
     GHC.Data.OrdList
    72 72 
     GHC.Data.OsPath
    73 73 
     GHC.Data.Pair
    74 
    +GHC.Data.SmallArray
    74 75 
     GHC.Data.Strict
    75 76 
     GHC.Data.StringBuffer
    76 77 
     GHC.Data.TrieMap

  • testsuite/tests/count-deps/CountDepsParser.stdout
    ... ... @@ -73,6 +73,7 @@ GHC.Data.Maybe
    73 73 
     GHC.Data.OrdList
    74 74 
     GHC.Data.OsPath
    75 75 
     GHC.Data.Pair
    76 
    +GHC.Data.SmallArray
    76 77 
     GHC.Data.Strict
    77 78 
     GHC.Data.StringBuffer
    78 79 
     GHC.Data.TrieMap

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help