[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: EPA: Use EpaLocation for RecFieldsDotDot
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Apr 8 10:23:35 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
19883a23 by Alan Zimmerman at 2024-04-05T16:58:17-04:00
EPA: Use EpaLocation for RecFieldsDotDot
So we can update it to a delta position in makeDeltaAst if needed.
- - - - -
e8724327 by Matthew Pickering at 2024-04-05T16:58:53-04:00
Remove accidentally committed test.hs
- - - - -
f724da82 by Fendor at 2024-04-08T06:23:19-04:00
Avoid UArray when indexing is not required
`UnlinkedBCO`'s can occur many times in the heap. Each `UnlinkedBCO`
references two `UArray`'s but never indexes them. They are only needed
to encode the elements into a `ByteArray#`. The three words for
the lower bound, upper bound and number of elements are essentially
unused, thus we replace `UArray` with a wrapper around `ByteArray#`.
This saves us up to three words for each `UnlinkedBCO`.
Further, to avoid re-allocating these words for `ResolvedBCO`, we repeat
the procedure for `ResolvedBCO` and add custom `Binary` and `Show` instances.
For example, agda's repl session has around 360_000 UnlinkedBCO's,
so avoiding these three words is already saving us around 8MB residency.
- - - - -
d42a8a04 by Fendor at 2024-04-08T06:23:20-04:00
Never UNPACK `FastMutInt` for counting z-encoded `FastString`s
In `FastStringTable`, we count the number of z-encoded FastStrings
that exist in a GHC session.
We used to UNPACK the counters to not waste memory, but live retainer
analysis showed that we allocate a lot of `FastMutInt`s, retained by
`mkFastZString`.
We lazily compute the `FastZString`, only incrementing the counter when the `FastZString` is
forced.
The function `mkFastStringWith` calls `mkZFastString` and boxes the
`FastMutInt`, leading to the following core:
mkFastStringWith
= \ mk_fs _ ->
= case stringTable of
{ FastStringTable _ n_zencs segments# _ ->
...
case ((mk_fs (I# ...) (FastMutInt n_zencs))
`cast` <Co:2> :: ...)
...
Marking this field as `NOUNPACK` avoids this reboxing, eliminating the
allocation of a fresh `FastMutInt` on every `FastString` allocation.
- - - - -
13 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Pat.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- − test.hs
- testsuite/tests/ghci/should_run/BinaryArray.hs
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -213,8 +213,8 @@ assembleBCO platform (ProtoBCO { protoBCOName = nm
(text "bytecode instruction count mismatch")
let asm_insns = ssElts final_insns
- insns_arr = Array.listArray (0, fromIntegral n_insns - 1) asm_insns
- bitmap_arr = mkBitmapArray bsize bitmap
+ !insns_arr = mkBCOByteArray $ Array.listArray (0 :: Int, fromIntegral n_insns - 1) asm_insns
+ !bitmap_arr = mkBCOByteArray $ mkBitmapArray bsize bitmap
ul_bco = UnlinkedBCO nm arity insns_arr bitmap_arr (fromSizedSeq final_lits) (fromSizedSeq final_ptrs)
-- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
@@ -224,7 +224,7 @@ assembleBCO platform (ProtoBCO { protoBCOName = nm
return ul_bco
-mkBitmapArray :: Word -> [StgWord] -> UArray Int Word64
+mkBitmapArray :: Word -> [StgWord] -> UArray Int Word
-- Here the return type must be an array of Words, not StgWords,
-- because the underlying ByteArray# will end up as a component
-- of a BCO object.
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -60,10 +60,13 @@ linkBCO interp le bco_ix
(UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do
-- fromIntegral Word -> Word64 should be a no op if Word is Word64
-- otherwise it will result in a cast to longlong on 32bit systems.
- lits <- mapM (fmap fromIntegral . lookupLiteral interp le) (elemsFlatBag lits0)
+ (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp le) (elemsFlatBag lits0)
ptrs <- mapM (resolvePtr interp le bco_ix) (elemsFlatBag ptrs0)
- return (ResolvedBCO isLittleEndian arity insns bitmap
- (listArray (0, fromIntegral (sizeFlatBag lits0)-1) lits)
+ let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits
+ return (ResolvedBCO isLittleEndian arity
+ insns
+ bitmap
+ (mkBCOByteArray lits')
(addListToSS emptySS ptrs))
lookupLiteral :: Interp -> LinkerEnv -> BCONPtr -> IO Word
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -1,6 +1,8 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnliftedNewtypes #-}
--
-- (c) The University of Glasgow 2002-2006
--
@@ -8,6 +10,7 @@
-- | Bytecode assembler types
module GHC.ByteCode.Types
( CompiledByteCode(..), seqCompiledByteCode
+ , BCOByteArray(..), mkBCOByteArray
, FFIInfo(..)
, RegBitmap(..)
, NativeCallType(..), NativeCallInfo(..), voidTupleReturnInfo, voidPrimCallInfo
@@ -34,10 +37,10 @@ import GHCi.BreakArray
import GHCi.RemoteTypes
import GHCi.FFI
import Control.DeepSeq
+import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray )
import Foreign
import Data.Array
-import Data.Array.Base ( UArray(..) )
import Data.ByteString (ByteString)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
@@ -153,8 +156,8 @@ data UnlinkedBCO
= UnlinkedBCO {
unlinkedBCOName :: !Name,
unlinkedBCOArity :: {-# UNPACK #-} !Int,
- unlinkedBCOInstrs :: !(UArray Int Word16), -- insns
- unlinkedBCOBitmap :: !(UArray Int Word64), -- bitmap
+ unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns
+ unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap
unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs
unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs
}
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -304,9 +304,18 @@ and updates to multiple buckets with low synchronization overhead.
See Note [Updating the FastString table] on how it's updated.
-}
data FastStringTable = FastStringTable
- {-# UNPACK #-} !FastMutInt -- the unique ID counter shared with all buckets
- {-# UNPACK #-} !FastMutInt -- number of computed z-encodings for all buckets
- (Array# (IORef FastStringTableSegment)) -- concurrent segments
+ {-# UNPACK #-} !FastMutInt
+ -- ^ The unique ID counter shared with all buckets
+ --
+ -- We unpack the 'FastMutInt' counter as it is always consumed strictly.
+ {-# NOUNPACK #-} !FastMutInt
+ -- ^ Number of computed z-encodings for all buckets.
+ --
+ -- We mark this as 'NOUNPACK' as this 'FastMutInt' is retained by a thunk
+ -- in 'mkFastStringWith' and needs to be boxed any way.
+ -- If this is unpacked, then we box this single 'FastMutInt' once for each
+ -- allocated FastString.
+ (Array# (IORef FastStringTableSegment)) -- ^ concurrent segments
data FastStringTableSegment = FastStringTableSegment
{-# UNPACK #-} !(MVar ()) -- the lock for write in each segment
=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -350,7 +350,7 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hfbLHS
instance Outputable (HsTyPat p) => Outputable (HsConPatTyArg p) where
ppr (HsConPatTyArg _ ty) = char '@' <> ppr ty
-instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ Located RecFieldsDotDot)
+instance (Outputable arg, Outputable (XRec p (HsRecField p arg)), XRec p RecFieldsDotDot ~ LocatedE RecFieldsDotDot)
=> Outputable (HsRecFields p arg) where
ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
= braces (fsep (punctuate comma (map ppr flds)))
@@ -976,4 +976,4 @@ type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA
type instance Anno (HsOverLit (GhcPass p)) = EpAnnCO
type instance Anno ConLike = SrcSpanAnnN
type instance Anno (HsFieldBind lhs rhs) = SrcSpanAnnA
-type instance Anno RecFieldsDotDot = SrcSpan
+type instance Anno RecFieldsDotDot = EpaLocation
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -1830,7 +1830,7 @@ lPatImplicits = hs_lpat
details (RecCon (HsRecFields { rec_dotdot = Nothing, rec_flds }))
= hs_lpats $ map (hfbRHS . unLoc) rec_flds
details (RecCon (HsRecFields { rec_dotdot = Just (L err_loc rec_dotdot), rec_flds }))
- = [(err_loc, implicit_field_binders)]
+ = [(l2l err_loc, implicit_field_binders)]
++ hs_lpats explicit_pats
where (explicit_pats, implicit_field_binders)
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -2679,7 +2679,7 @@ mkRdrRecordCon con flds anns
mk_rec_fields :: [LocatedA (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg
mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
mk_rec_fields fs (Just s) = HsRecFields { rec_flds = fs
- , rec_dotdot = Just (L s (RecFieldsDotDot $ length fs)) }
+ , rec_dotdot = Just (L (l2l s) (RecFieldsDotDot $ length fs)) }
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs GhcPs
mk_rec_upd_field (HsFieldBind noAnn (L loc (FieldOcc _ rdr)) arg pun)
=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -775,7 +775,7 @@ rnHsRecPatsAndThen mk (L _ con)
do { arg' <- rnLPatAndThen (nested_mk dd mk (RecFieldsDotDot n')) (hfbRHS fld)
; return (L l (fld { hfbRHS = arg' })) }
- loc = maybe noSrcSpan getLoc dd
+ loc = maybe noSrcSpan getLocA dd
-- Don't warn for let P{..} = ... in ...
check_unused_wildcard = case mk of
@@ -873,12 +873,12 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
, hfbRHS = arg'
, hfbPun = pun } }
- rn_dotdot :: Maybe (Located RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat
+ rn_dotdot :: Maybe (LocatedE RecFieldsDotDot) -- See Note [DotDot fields] in GHC.Hs.Pat
-> Maybe Name -- The constructor (Nothing for an
-- out of scope constructor)
-> [LHsRecField GhcRn (LocatedA arg)] -- Explicit fields
-> RnM ([LHsRecField GhcRn (LocatedA arg)]) -- Field Labels we need to fill in
- rn_dotdot (Just (L loc (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match
+ rn_dotdot (Just (L loc_e (RecFieldsDotDot n))) (Just con) flds -- ".." on record construction / pat match
| not (isUnboundName con) -- This test is because if the constructor
-- isn't in scope the constructor lookup will add
-- an error but still return an unbound name. We
@@ -910,6 +910,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
_other -> True ]
; addUsedGREs NoDeprecationWarnings dot_dot_gres
+ ; let loc = locA loc_e
; let locn = noAnnSrcSpan loc
; return [ L (noAnnSrcSpan loc) (HsFieldBind
{ hfbAnn = noAnn
=====================================
libraries/ghci/GHCi/CreateBCO.hs
=====================================
@@ -68,9 +68,6 @@ createBCO arr bco
return (HValue final_bco) }
-toWordArray :: UArray Int Word64 -> UArray Int Word
-toWordArray = amap fromIntegral
-
linkBCO' :: Array Int HValue -> ResolvedBCO -> IO BCO
linkBCO' arr ResolvedBCO{..} = do
let
@@ -80,11 +77,10 @@ linkBCO' arr ResolvedBCO{..} = do
!(I# arity#) = resolvedBCOArity
!(EmptyArr empty#) = emptyArr -- See Note [BCO empty array]
-
- barr a = case a of UArray _lo _hi n b -> if n == 0 then empty# else b
- insns_barr = barr resolvedBCOInstrs
- bitmap_barr = barr (toWordArray resolvedBCOBitmap)
- literals_barr = barr (toWordArray resolvedBCOLits)
+ barr arr# = if I# (sizeofByteArray# arr#) == 0 then empty# else arr#
+ insns_barr = barr (getBCOByteArray resolvedBCOInstrs)
+ bitmap_barr = barr (getBCOByteArray resolvedBCOBitmap)
+ literals_barr = barr (getBCOByteArray resolvedBCOLits)
PtrsArr marr <- mkPtrsArray arr n_ptrs ptrs
IO $ \s ->
=====================================
libraries/ghci/GHCi/ResolvedBCO.hs
=====================================
@@ -1,9 +1,12 @@
{-# LANGUAGE RecordWildCards, DeriveGeneric, GeneralizedNewtypeDeriving,
- BangPatterns, CPP #-}
+ BangPatterns, CPP, MagicHash, FlexibleInstances, FlexibleContexts,
+ TypeApplications, ScopedTypeVariables, UnboxedTuples #-}
module GHCi.ResolvedBCO
( ResolvedBCO(..)
, ResolvedBCOPtr(..)
, isLittleEndian
+ , BCOByteArray(..)
+ , mkBCOByteArray
) where
import Prelude -- See note [Why do we import Prelude here?]
@@ -11,11 +14,19 @@ import GHC.Data.SizedSeq
import GHCi.RemoteTypes
import GHCi.BreakArray
-import Data.Array.Unboxed
import Data.Binary
+import Data.Binary.Put (putBuilder)
import GHC.Generics
-import GHCi.BinaryArray
+import Foreign.Ptr
+import Data.Array.Byte
+import qualified Data.Binary.Get.Internal as Binary
+import qualified Data.ByteString.Builder as BB
+import qualified Data.ByteString.Builder.Internal as BB
+import GHC.Exts
+import Data.Array.Base (UArray(..))
+
+import GHC.IO
#include "MachDeps.h"
@@ -32,19 +43,35 @@ isLittleEndian = True
-- | A 'ResolvedBCO' is one in which all the 'Name' references have been
-- resolved to actual addresses or 'RemoteHValues'.
--
--- Note, all arrays are zero-indexed (we assume this when
--- serializing/deserializing)
data ResolvedBCO
= ResolvedBCO {
resolvedBCOIsLE :: Bool,
resolvedBCOArity :: {-# UNPACK #-} !Int,
- resolvedBCOInstrs :: UArray Int Word16, -- insns
- resolvedBCOBitmap :: UArray Int Word64, -- bitmap
- resolvedBCOLits :: UArray Int Word64, -- non-ptrs
+ resolvedBCOInstrs :: BCOByteArray Word16, -- insns
+ resolvedBCOBitmap :: BCOByteArray Word, -- bitmap
+ resolvedBCOLits :: BCOByteArray Word, -- non-ptrs
resolvedBCOPtrs :: (SizedSeq ResolvedBCOPtr) -- ptrs
}
deriving (Generic, Show)
+-- | Wrapper for a 'ByteArray#'.
+-- The phantom type tells what elements are stored in the 'ByteArray#'.
+-- Creating a 'ByteArray#' can be achieved using 'UArray''s API,
+-- where the underlying 'ByteArray#' can be unpacked.
+data BCOByteArray a
+ = BCOByteArray {
+ getBCOByteArray :: !ByteArray#
+ }
+
+mkBCOByteArray :: UArray Int a -> BCOByteArray a
+mkBCOByteArray (UArray _ _ _ arr) = BCOByteArray arr
+
+instance Show (BCOByteArray Word16) where
+ showsPrec _ _ = showString "BCOByteArray Word16"
+
+instance Show (BCOByteArray Word) where
+ showsPrec _ _ = showString "BCOByteArray Word"
+
-- | The Binary instance for ResolvedBCOs.
--
-- Note, that we do encode the endianness, however there is no support for mixed
@@ -54,12 +81,16 @@ instance Binary ResolvedBCO where
put ResolvedBCO{..} = do
put resolvedBCOIsLE
put resolvedBCOArity
- putArray resolvedBCOInstrs
- putArray resolvedBCOBitmap
- putArray resolvedBCOLits
+ put resolvedBCOInstrs
+ put resolvedBCOBitmap
+ put resolvedBCOLits
put resolvedBCOPtrs
- get = ResolvedBCO
- <$> get <*> get <*> getArray <*> getArray <*> getArray <*> get
+ get = ResolvedBCO <$> get <*> get <*> get <*> get <*> get <*> get
+
+instance Binary (BCOByteArray a) where
+ put = putBCOByteArray
+ get = decodeBCOByteArray
+
data ResolvedBCOPtr
= ResolvedBCORef {-# UNPACK #-} !Int
@@ -75,3 +106,65 @@ data ResolvedBCOPtr
deriving (Generic, Show)
instance Binary ResolvedBCOPtr
+
+-- --------------------------------------------------------
+-- Serialisers for 'BCOByteArray'
+-- --------------------------------------------------------
+
+putBCOByteArray :: BCOByteArray a -> Put
+putBCOByteArray (BCOByteArray bar) = do
+ put (I# (sizeofByteArray# bar))
+ putBuilder $ byteArrayBuilder bar
+
+decodeBCOByteArray :: Get (BCOByteArray a)
+decodeBCOByteArray = do
+ n <- get
+ getByteArray n
+
+byteArrayBuilder :: ByteArray# -> BB.Builder
+byteArrayBuilder arr# = BB.builder $ go 0 (I# (sizeofByteArray# arr#))
+ where
+ go :: Int -> Int -> BB.BuildStep a -> BB.BuildStep a
+ go !inStart !inEnd k (BB.BufferRange outStart outEnd)
+ -- There is enough room in this output buffer to write all remaining array
+ -- contents
+ | inRemaining <= outRemaining = do
+ copyByteArrayToAddr arr# inStart outStart inRemaining
+ k (BB.BufferRange (outStart `plusPtr` inRemaining) outEnd)
+ -- There is only enough space for a fraction of the remaining contents
+ | otherwise = do
+ copyByteArrayToAddr arr# inStart outStart outRemaining
+ let !inStart' = inStart + outRemaining
+ return $! BB.bufferFull 1 outEnd (go inStart' inEnd k)
+ where
+ inRemaining = inEnd - inStart
+ outRemaining = outEnd `minusPtr` outStart
+
+ copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO ()
+ copyByteArrayToAddr src# (I# src_off#) (Ptr dst#) (I# len#) =
+ IO $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of
+ s' -> (# s', () #)
+
+getByteArray :: Int -> Get (BCOByteArray a)
+getByteArray nbytes@(I# nbytes#) = do
+ let !(MutableByteArray arr#) = unsafeDupablePerformIO $
+ IO $ \s -> case newByteArray# nbytes# s of
+ (# s', mbar #) -> (# s', MutableByteArray mbar #)
+ let go 0 _ = return ()
+ go !remaining !off = do
+ Binary.readNWith n $ \ptr ->
+ copyAddrToByteArray ptr arr# off n
+ go (remaining - n) (off + n)
+ where n = min chunkSize remaining
+ go nbytes 0
+ return $! unsafeDupablePerformIO $
+ IO $ \s -> case unsafeFreezeByteArray# arr# s of
+ (# s', bar #) -> (# s', BCOByteArray bar #)
+ where
+ chunkSize = 10*1024
+
+ copyAddrToByteArray :: Ptr a -> MutableByteArray# RealWorld
+ -> Int -> Int -> IO ()
+ copyAddrToByteArray (Ptr src#) dst# (I# dst_off#) (I# len#) =
+ IO $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of
+ s' -> (# s', () #)
=====================================
test.hs deleted
=====================================
@@ -1,14 +0,0 @@
-import Data.Char
-import Data.Foldable
--- | Just like 'GHC.ResponseFile.escapeArg', but it is not exposed from base.
-escapeArg :: String -> String
-escapeArg = reverse . foldl' escape []
-
-escape :: String -> Char -> String
-escape cs c
- | isSpace c
- || '\\' == c
- || '\'' == c
- || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result
- | otherwise = c:cs
-
=====================================
testsuite/tests/ghci/should_run/BinaryArray.hs
=====================================
@@ -1,11 +1,15 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, MagicHash, ScopedTypeVariables #-}
import Data.Binary.Get
import Data.Binary.Put
+import Data.Binary (get, put)
+import Data.Array.Byte
import Data.Array.Unboxed as AU
import Data.Array.IO (IOUArray)
import Data.Array.MArray (MArray)
import Data.Array as A
+import Data.Array.Base as A
import GHCi.BinaryArray
+import GHCi.ResolvedBCO
import GHC.Word
roundtripTest :: (IArray UArray a, MArray IOUArray a IO, Eq a)
@@ -18,6 +22,17 @@ roundtripTest arr =
| otherwise -> putStrLn "failed to round-trip"
Left _ -> putStrLn "deserialization failed"
+roundtripTestByteArray :: forall a . (IArray UArray a, MArray IOUArray a IO, Eq a)
+ => UArray Int a -> IO ()
+roundtripTestByteArray (UArray _ _ _ arr#) =
+ let val = BCOByteArray arr# :: BCOByteArray a
+ ser = Data.Binary.Put.runPut $ put val
+ in case Data.Binary.Get.runGetOrFail (get :: Get (BCOByteArray a)) ser of
+ Right (_, _, BCOByteArray arr'# )
+ | ByteArray arr# == ByteArray arr'# -> return ()
+ | otherwise -> putStrLn "failed to round-trip"
+ Left _ -> putStrLn "deserialization failed"
+
main :: IO ()
main = do
roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Int)
@@ -27,3 +42,10 @@ main = do
roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word32)
roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word64)
roundtripTest (AU.listArray (1,500) ['a'..] :: UArray Int Char)
+ roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Int)
+ roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word)
+ roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word8)
+ roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word16)
+ roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word32)
+ roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word64)
+ roundtripTestByteArray (AU.listArray (1,500) ['a'..] :: UArray Int Char)
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -3328,12 +3328,13 @@ instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where
setAnnotationAnchor a _ _ _ = a
exact (HsRecFields fields mdot) = do
fields' <- markAnnotated fields
- case mdot of
- Nothing -> return ()
- Just (L ss _) ->
- printStringAtSs ss ".." >> return ()
+ mdot' <- case mdot of
+ Nothing -> return Nothing
+ Just (L ss d) -> do
+ ss' <- printStringAtAA ss ".."
+ return $ Just (L ss' d)
-- Note: mdot contains the SrcSpan where the ".." appears, if present
- return (HsRecFields fields' mdot)
+ return (HsRecFields fields' mdot')
-- ---------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81bbfde980e4a60daafd22de09609e91c261ae4a...d42a8a04e8d73b75110ad376149ac071987481dd
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81bbfde980e4a60daafd22de09609e91c261ae4a...d42a8a04e8d73b75110ad376149ac071987481dd
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/20240408/91c2fa8e/attachment-0001.html>
More information about the ghc-commits
mailing list