[Git][ghc/ghc][wip/T20201] 10 commits: EPA: Use EpaLocation for RecFieldsDotDot
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Wed Apr 10 19:17:28 UTC 2024
Ben Gamari pushed to branch wip/T20201 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
- - - - -
88cb3e10 by Fendor at 2024-04-08T09:03:34-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.
- - - - -
f2cc1107 by Fendor at 2024-04-08T09:04:11-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.
- - - - -
c6def949 by Matthew Pickering at 2024-04-08T16:06:51-04:00
Force in_multi to avoid retaining entire hsc_env
- - - - -
fbb91a63 by Fendor at 2024-04-08T16:06:51-04:00
Eliminate name thunk in declaration fingerprinting
Thunk analysis showed that we have about 100_000 thunks (in agda and
`-fwrite-simplified-core`) pointing to the name of the name decl.
Forcing this thunk fixes this issue.
The thunk created here is retained by the thunk created by forkM, it is
better to eagerly force this because the result (a `Name`) is already
retained indirectly via the `IfaceDecl`.
- - - - -
3b7b0c1c by Alan Zimmerman at 2024-04-08T16:07:27-04:00
EPA: Use EpaLocation in WarningTxt
This allows us to use an EpDelta if needed when using makeDeltaAst.
- - - - -
12b997df by Alan Zimmerman at 2024-04-08T16:07:27-04:00
EPA: Move DeltaPos and EpaLocation' into GHC.Types.SrcLoc
This allows us to use a NoCommentsLocation for the possibly trailing
comma location in a StringLiteral.
This in turn allows us to correctly roundtrip via makeDeltaAst.
- - - - -
c73dc703 by Ben Gamari at 2024-04-10T15:17:10-04:00
rts/RtsFlags: Refactor size parsing
This makes a number of improvements mentioned in #20201:
* fail if the argument cannot be parsed as a number (`-Mturtles`)
* fail if an unrecognized unit is given (e.g. `-M1x`)
- - - - -
e6d181bd by Ben Gamari at 2024-04-10T15:17:10-04:00
testsuite: Add tests for RTS flag parsing error handling
See #20201.
- - - - -
28 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/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Types/SourceText.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Unit/Module/Warnings.hs
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- rts/RtsFlags.c
- − test.hs
- testsuite/tests/ghci/should_run/BinaryArray.hs
- + testsuite/tests/rts/T20201a.hs
- + testsuite/tests/rts/T20201a.stderr
- + testsuite/tests/rts/T20201b.hs
- + testsuite/tests/rts/T20201b.stderr
- testsuite/tests/rts/all.T
- 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/Iface/Syntax.hs
=====================================
@@ -595,8 +595,8 @@ fromIfaceWarnings = \case
fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn
fromIfaceWarningTxt = \case
- IfWarningTxt mb_cat src strs -> WarningTxt (noLoc . fromWarningCategory <$> mb_cat) src (noLoc <$> map fromIfaceStringLiteralWithNames strs)
- IfDeprecatedTxt src strs -> DeprecatedTxt src (noLoc <$> map fromIfaceStringLiteralWithNames strs)
+ IfWarningTxt mb_cat src strs -> WarningTxt (noLocA . fromWarningCategory <$> mb_cat) src (noLocA <$> map fromIfaceStringLiteralWithNames strs)
+ IfDeprecatedTxt src strs -> DeprecatedTxt src (noLocA <$> map fromIfaceStringLiteralWithNames strs)
fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn
fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names)
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -956,7 +956,9 @@ tc_iface_decl_fingerprint :: Bool -- Don't load pragmas into
tc_iface_decl_fingerprint ignore_prags (_version, decl)
= do { -- Populate the name cache with final versions of all
-- the names associated with the decl
- let main_name = ifName decl
+ let !main_name = ifName decl
+ -- Force this field access, as `main_name` thunk will otherwise
+ -- be retained in the thunk created by `forkM`.
-- Typecheck the thing, lazily
-- NB. Firstly, the laziness is there in case we never need the
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1964,9 +1964,9 @@ maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }
(AnnPragma (mo $1) (mc $4) (fst $ unLoc $3))}
| {- empty -} { Nothing }
-warning_category :: { Maybe (Located InWarningCategory) }
- : 'in' STRING { Just (sLL $1 $> $ InWarningCategory (epTok $1) (getSTRINGs $2)
- (sL1 $2 $ mkWarningCategory (getSTRING $2))) }
+warning_category :: { Maybe (LocatedE InWarningCategory) }
+ : 'in' STRING { Just (reLoc $ sLL $1 $> $ InWarningCategory (epTok $1) (getSTRINGs $2)
+ (reLoc $ sL1 $2 $ mkWarningCategory (getSTRING $2))) }
| {- empty -} { Nothing }
warnings :: { OrdList (LWarnDecl GhcPs) }
@@ -4131,8 +4131,8 @@ getSCC lt = do let s = getSTRING lt
then addFatalError $ mkPlainErrorMsgEnvelope (getLoc lt) $ PsErrSpaceInSCC
else return s
-stringLiteralToHsDocWst :: Located StringLiteral -> Located (WithHsDocIdentifiers StringLiteral GhcPs)
-stringLiteralToHsDocWst = lexStringLiteral parseIdentifier
+stringLiteralToHsDocWst :: Located StringLiteral -> LocatedE (WithHsDocIdentifiers StringLiteral GhcPs)
+stringLiteralToHsDocWst sl = reLoc $ lexStringLiteral parseIdentifier sl
-- Utilities for combining source spans
comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan
@@ -4560,7 +4560,7 @@ addTrailingCommaN (L anns a) span = do
addTrailingCommaS :: Located StringLiteral -> EpaLocation -> Located StringLiteral
addTrailingCommaS (L l sl) span
- = L (widenSpan l [AddEpAnn AnnComma span]) (sl { sl_tc = Just (epaLocationRealSrcSpan span) })
+ = L (widenSpan l [AddEpAnn AnnComma span]) (sl { sl_tc = Just (epaToNoCommentsLocation span) })
-- -------------------------------------
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -454,27 +454,8 @@ instance Outputable EpaComment where
-- annotation.
data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Eq)
--- | The anchor for an @'AnnKeywordId'@. The Parser inserts the
--- @'EpaSpan'@ variant, giving the exact location of the original item
--- in the parsed source. This can be replaced by the @'EpaDelta'@
--- version, to provide a position for the item relative to the end of
--- the previous item in the source. This is useful when editing an
--- AST prior to exact printing the changed one. The list of comments
--- in the @'EpaDelta'@ variant captures any comments between the prior
--- output and the thing being marked here, since we cannot otherwise
--- sort the relative order.
-
-data EpaLocation' a = EpaSpan !SrcSpan
- | EpaDelta !DeltaPos !a
- deriving (Data,Eq,Show)
-
type EpaLocation = EpaLocation' [LEpaComment]
-type NoCommentsLocation = EpaLocation' NoComments
-
-data NoComments = NoComments
- deriving (Data,Eq,Ord,Show)
-
epaToNoCommentsLocation :: EpaLocation -> NoCommentsLocation
epaToNoCommentsLocation (EpaSpan ss) = EpaSpan ss
epaToNoCommentsLocation (EpaDelta dp []) = EpaDelta dp NoComments
@@ -492,34 +473,6 @@ data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation
instance Outputable a => Outputable (GenLocated TokenLocation a) where
ppr (L _ x) = ppr x
--- | Spacing between output items when exact printing. It captures
--- the spacing from the current print position on the page to the
--- position required for the thing about to be printed. This is
--- either on the same line in which case is is simply the number of
--- spaces to emit, or it is some number of lines down, with a given
--- column offset. The exact printing algorithm keeps track of the
--- column offset pertaining to the current anchor position, so the
--- `deltaColumn` is the additional spaces to add in this case. See
--- https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations for
--- details.
-data DeltaPos
- = SameLine { deltaColumn :: !Int }
- | DifferentLine
- { deltaLine :: !Int, -- ^ deltaLine should always be > 0
- deltaColumn :: !Int
- } deriving (Show,Eq,Ord,Data)
-
--- | Smart constructor for a 'DeltaPos'. It preserves the invariant
--- that for the 'DifferentLine' constructor 'deltaLine' is always > 0.
-deltaPos :: Int -> Int -> DeltaPos
-deltaPos l c = case l of
- 0 -> SameLine c
- _ -> DifferentLine l c
-
-getDeltaLine :: DeltaPos -> Int
-getDeltaLine (SameLine _) = 0
-getDeltaLine (DifferentLine r _) = r
-
-- | Used in the parser only, extract the 'RealSrcSpan' from an
-- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the
-- partial function is safe.
@@ -527,13 +480,6 @@ epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan (EpaSpan (RealSrcSpan r _)) = r
epaLocationRealSrcSpan _ = panic "epaLocationRealSrcSpan"
-instance Outputable NoComments where
- ppr NoComments = text "NoComments"
-
-instance (Outputable a) => Outputable (EpaLocation' a) where
- ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
- ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs
-
instance Outputable AddEpAnn where
ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss
@@ -1419,10 +1365,6 @@ instance (Outputable a) => Outputable (EpAnn a) where
instance Outputable NoEpAnns where
ppr NoEpAnns = text "NoEpAnns"
-instance Outputable DeltaPos where
- ppr (SameLine c) = text "SameLine" <+> ppr c
- ppr (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c
-
instance Outputable (GenLocated NoCommentsLocation EpaComment) where
ppr (L l c) = text "L" <+> ppr l <+> ppr c
=====================================
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/Module.hs
=====================================
@@ -310,7 +310,7 @@ rnWarningTxt :: WarningTxt GhcPs -> RnM (WarningTxt GhcRn)
rnWarningTxt (WarningTxt mb_cat st wst) = do
forM_ mb_cat $ \(L _ (InWarningCategory _ _ (L loc cat))) ->
unless (validWarningCategory cat) $
- addErrAt loc (TcRnInvalidWarningCategory cat)
+ addErrAt (locA loc) (TcRnInvalidWarningCategory cat)
wst' <- traverse (traverse rnHsDoc) wst
pure (WarningTxt mb_cat st wst')
rnWarningTxt (DeprecatedTxt st wst) = do
=====================================
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
=====================================
compiler/GHC/Types/SourceText.hs
=====================================
@@ -305,17 +305,13 @@ data StringLiteral = StringLiteral
{ sl_st :: SourceText, -- literal raw source.
-- See Note [Literal source text]
sl_fs :: FastString, -- literal string value
- sl_tc :: Maybe RealSrcSpan -- Location of
+ sl_tc :: Maybe NoCommentsLocation
+ -- Location of
-- possible
-- trailing comma
-- AZ: if we could have a LocatedA
-- StringLiteral we would not need sl_tc, but
-- that would cause import loops.
-
- -- AZ:2: sl_tc should be an EpaAnchor, to allow
- -- editing and reprinting the AST. Need a more
- -- robust solution.
-
} deriving Data
instance Eq StringLiteral where
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -109,6 +109,10 @@ module GHC.Types.SrcLoc (
mkSrcSpanPs,
combineRealSrcSpans,
psLocatedToLocated,
+
+ -- * Exact print locations
+ EpaLocation'(..), NoCommentsLocation, NoComments(..),
+ DeltaPos(..), deltaPos, getDeltaLine,
) where
import GHC.Prelude
@@ -894,3 +898,70 @@ psSpanEnd (PsSpan r b) = PsLoc (realSrcSpanEnd r) (bufSpanEnd b)
mkSrcSpanPs :: PsSpan -> SrcSpan
mkSrcSpanPs (PsSpan r b) = RealSrcSpan r (Strict.Just b)
+
+-- ---------------------------------------------------------------------
+-- The following section contains basic types related to exact printing.
+-- See https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations for
+-- details.
+-- This is only s subset, to prevent import loops. The balance are in
+-- GHC.Parser.Annotation
+-- ---------------------------------------------------------------------
+
+
+-- | The anchor for an @'AnnKeywordId'@. The Parser inserts the
+-- @'EpaSpan'@ variant, giving the exact location of the original item
+-- in the parsed source. This can be replaced by the @'EpaDelta'@
+-- version, to provide a position for the item relative to the end of
+-- the previous item in the source. This is useful when editing an
+-- AST prior to exact printing the changed one. The list of comments
+-- in the @'EpaDelta'@ variant captures any comments between the prior
+-- output and the thing being marked here, since we cannot otherwise
+-- sort the relative order.
+
+data EpaLocation' a = EpaSpan !SrcSpan
+ | EpaDelta !DeltaPos !a
+ deriving (Data,Eq,Show)
+
+type NoCommentsLocation = EpaLocation' NoComments
+
+data NoComments = NoComments
+ deriving (Data,Eq,Ord,Show)
+
+-- | Spacing between output items when exact printing. It captures
+-- the spacing from the current print position on the page to the
+-- position required for the thing about to be printed. This is
+-- either on the same line in which case is is simply the number of
+-- spaces to emit, or it is some number of lines down, with a given
+-- column offset. The exact printing algorithm keeps track of the
+-- column offset pertaining to the current anchor position, so the
+-- `deltaColumn` is the additional spaces to add in this case. See
+-- https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations for
+-- details.
+data DeltaPos
+ = SameLine { deltaColumn :: !Int }
+ | DifferentLine
+ { deltaLine :: !Int, -- ^ deltaLine should always be > 0
+ deltaColumn :: !Int
+ } deriving (Show,Eq,Ord,Data)
+
+-- | Smart constructor for a 'DeltaPos'. It preserves the invariant
+-- that for the 'DifferentLine' constructor 'deltaLine' is always > 0.
+deltaPos :: Int -> Int -> DeltaPos
+deltaPos l c = case l of
+ 0 -> SameLine c
+ _ -> DifferentLine l c
+
+getDeltaLine :: DeltaPos -> Int
+getDeltaLine (SameLine _) = 0
+getDeltaLine (DifferentLine r _) = r
+
+instance Outputable NoComments where
+ ppr NoComments = text "NoComments"
+
+instance (Outputable a) => Outputable (EpaLocation' a) where
+ ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
+ ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs
+
+instance Outputable DeltaPos where
+ ppr (SameLine c) = text "SameLine" <+> ppr c
+ ppr (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c
=====================================
compiler/GHC/Unit/Module/Warnings.hs
=====================================
@@ -121,11 +121,11 @@ data InWarningCategory
= InWarningCategory
{ iwc_in :: !(EpToken "in"),
iwc_st :: !SourceText,
- iwc_wc :: (Located WarningCategory)
+ iwc_wc :: (LocatedE WarningCategory)
} deriving Data
fromWarningCategory :: WarningCategory -> InWarningCategory
-fromWarningCategory wc = InWarningCategory noAnn NoSourceText (noLoc wc)
+fromWarningCategory wc = InWarningCategory noAnn NoSourceText (noLocA wc)
-- See Note [Warning categories]
@@ -201,14 +201,14 @@ type LWarningTxt pass = XRec pass (WarningTxt pass)
-- reason/explanation from a WARNING or DEPRECATED pragma
data WarningTxt pass
= WarningTxt
- (Maybe (Located InWarningCategory))
+ (Maybe (LocatedE InWarningCategory))
-- ^ Warning category attached to this WARNING pragma, if any;
-- see Note [Warning categories]
SourceText
- [Located (WithHsDocIdentifiers StringLiteral pass)]
+ [LocatedE (WithHsDocIdentifiers StringLiteral pass)]
| DeprecatedTxt
SourceText
- [Located (WithHsDocIdentifiers StringLiteral pass)]
+ [LocatedE (WithHsDocIdentifiers StringLiteral pass)]
deriving Generic
-- | To which warning category does this WARNING or DEPRECATED pragma belong?
@@ -218,7 +218,7 @@ warningTxtCategory (WarningTxt (Just (L _ (InWarningCategory _ _ (L _ cat)))) _
warningTxtCategory _ = defaultWarningCategory
-- | The message that the WarningTxt was specified to output
-warningTxtMessage :: WarningTxt p -> [Located (WithHsDocIdentifiers StringLiteral p)]
+warningTxtMessage :: WarningTxt p -> [LocatedE (WithHsDocIdentifiers StringLiteral p)]
warningTxtMessage (WarningTxt _ _ m) = m
warningTxtMessage (DeprecatedTxt _ m) = m
@@ -260,7 +260,7 @@ instance Outputable (WarningTxt pass) where
NoSourceText -> pp_ws ds
SourceText src -> ftext src <+> pp_ws ds <+> text "#-}"
-pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
+pp_ws :: [LocatedE (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
pp_ws [l] = ppr $ unLoc l
pp_ws ws
= text "["
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -557,7 +557,8 @@ interactiveUI config srcs maybe_exprs = do
-- Set to True because Prelude is implicitly imported.
impDecl at ImportDecl{ideclExt=ext} -> impDecl{ideclExt = ext{ideclImplicit=True}}
hsc_env <- GHC.getSession
- let in_multi = length (hsc_all_home_unit_ids hsc_env) > 1
+ let !in_multi = length (hsc_all_home_unit_ids hsc_env) > 1
+ -- We force this to make sure we don't retain the hsc_env when reloading
empty_cache <- liftIO newIfaceCache
startGHCi (runGHCi srcs maybe_exprs)
GHCiState{ progname = default_progname,
=====================================
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', () #)
=====================================
rts/RtsFlags.c
=====================================
@@ -2124,7 +2124,6 @@ static void initStatsFile (FILE *f)
static StgWord64
decodeSize(const char *flag, uint32_t offset, StgWord64 min, StgWord64 max)
{
- char c;
const char *s;
StgDouble m;
StgWord64 val;
@@ -2137,19 +2136,45 @@ decodeSize(const char *flag, uint32_t offset, StgWord64 min, StgWord64 max)
}
else
{
- m = atof(s);
- c = s[strlen(s)-1];
-
- if (c == 't' || c == 'T')
- m *= (StgWord64)1024*1024*1024*1024;
- else if (c == 'g' || c == 'G')
- m *= 1024*1024*1024;
- else if (c == 'm' || c == 'M')
- m *= 1024*1024;
- else if (c == 'k' || c == 'K')
- m *= 1024;
- else if (c == 'w' || c == 'W')
- m *= sizeof(W_);
+ char *end;
+ m = strtod(s, &end);
+
+ if (end == s) {
+ errorBelch("error in RTS option %s: unable to parse number '%s'", flag, s);
+ stg_exit(EXIT_FAILURE);
+ }
+
+ StgWord64 unit;
+ switch (*end) {
+ case 't':
+ case 'T':
+ unit = (StgWord64)1024*1024*1024*1024;
+ break;
+ case 'g':
+ case 'G':
+ unit = 1024*1024*1024;
+ break;
+ case 'm':
+ case 'M':
+ unit = 1024*1024;
+ break;
+ case 'k':
+ case 'K':
+ unit = 1024;
+ break;
+ case 'w':
+ case 'W':
+ unit = sizeof(W_);
+ break;
+ case '\0':
+ unit = 1;
+ break;
+ default:
+ errorBelch("error in RTS option %s: unknown unit suffix '%c'", flag, *end);
+ stg_exit(EXIT_FAILURE);
+ }
+
+ m *= unit;
}
val = (StgWord64)m;
=====================================
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)
=====================================
testsuite/tests/rts/T20201a.hs
=====================================
@@ -0,0 +1 @@
+main = putStrLn "hi"
=====================================
testsuite/tests/rts/T20201a.stderr
=====================================
@@ -0,0 +1 @@
+T20201a: error in RTS option -AturtlesM: unable to parse number 'turtlesM'
=====================================
testsuite/tests/rts/T20201b.hs
=====================================
@@ -0,0 +1,2 @@
+main = putStrLn "hi"
+
=====================================
testsuite/tests/rts/T20201b.stderr
=====================================
@@ -0,0 +1 @@
+T20201b: error in RTS option -A64z: unknown unit suffix 'z'
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -609,3 +609,6 @@ test('T23400', [], compile_and_run, ['-with-rtsopts -A8k'])
test('IOManager', [js_skip, when(arch('wasm32'), skip), when(opsys('mingw32'), skip),
pre_cmd('$MAKE -s --no-print-directory IOManager.hs')],
compile_and_run, [''])
+
+test('T20201a', exit_code(1), compile_and_run, ['-with-rtsopts -AturtlesM'])
+test('T20201b', exit_code(1), compile_and_run, ['-with-rtsopts -A64z'])
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -711,6 +711,11 @@ printStringAtMLocL (EpAnn anc an cs) l s = do
printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLocation
printStringAtAA el str = printStringAtAAC CaptureComments el str
+printStringAtNC :: (Monad m, Monoid w) => NoCommentsLocation -> String -> EP w m NoCommentsLocation
+printStringAtNC el str = do
+ el' <- printStringAtAAC NoCaptureComments (noCommentsToEpaLocation el) str
+ return (epaToNoCommentsLocation el')
+
printStringAtAAL :: (Monad m, Monoid w)
=> a -> Lens a EpaLocation -> String -> EP w m a
printStringAtAAL an l str = do
@@ -2117,10 +2122,10 @@ instance ExactPrint StringLiteral where
getAnnotationEntry = const NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact l@(StringLiteral src fs mcomma) = do
+ exact (StringLiteral src fs mcomma) = do
printSourceTextAA src (show (unpackFS fs))
- mapM_ (\r -> printStringAtRs r ",") mcomma
- return l
+ mcomma' <- mapM (\r -> printStringAtNC r ",") mcomma
+ return (StringLiteral src fs mcomma')
-- ---------------------------------------------------------------------
@@ -3328,12 +3333,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/63773182b0d55a3d1954c0dfaf5158c595680243...e6d181bd90baa751b80ddc77490e1bbb3bf29a82
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63773182b0d55a3d1954c0dfaf5158c595680243...e6d181bd90baa751b80ddc77490e1bbb3bf29a82
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/20240410/c87182c1/attachment-0001.html>
More information about the ghc-commits
mailing list