[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Do not use O_NONBLOCK on regular files or block devices

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Mon Oct 9 14:15:52 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
e206be64 by Andrew Lelechenko at 2023-10-08T15:06:14-04:00
Do not use O_NONBLOCK on regular files or block devices

CLC proposal https://github.com/haskell/core-libraries-committee/issues/166

- - - - -
a06197c4 by David Binder at 2023-10-08T15:06:55-04:00
Update hpc-bin submodule to 0.69

- - - - -
ed6785b6 by David Binder at 2023-10-08T15:06:55-04:00
Update Hadrian with correct path to happy file for hpc-bin

- - - - -
986c1a4d by Alan Zimmerman at 2023-10-09T10:15:40-04:00
EPA: Introduce HasAnnotation class

The class is defined as

    class HasAnnotation e where
      noAnnSrcSpan :: SrcSpan -> e

This generalises noAnnSrcSpan, and allows

    noLocA :: (HasAnnotation e) => a -> GenLocated e a
    noLocA = L (noAnnSrcSpan noSrcSpan)

- - - - -
a703f290 by Ben Gamari at 2023-10-09T10:15:40-04:00
Bump unix submodule to v2.8.3.0

- - - - -


16 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/ThToHs.hs
- hadrian/src/Rules/SourceDist.hs
- libraries/base/GHC/IO/FD.hs
- libraries/base/changelog.md
- libraries/unix
- testsuite/tests/hpc/T17073.stdout
- utils/check-exact/Orphans.hs
- utils/check-exact/Utils.hs
- utils/hpc


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -2187,6 +2187,6 @@ type instance Anno FastString                      = SrcAnn NoEpAnns
 
 type instance Anno (DotFieldOcc (GhcPass p))       = SrcAnn NoEpAnns
 
-instance (Anno a ~ SrcSpanAnn' (EpAnn an))
+instance (Anno a ~ SrcSpanAnn' (EpAnn an), NoAnn an)
    => WrapXRec (GhcPass p) a where
   wrapXRec = noLocA


=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -108,6 +108,7 @@ type instance Anno Name    = SrcSpanAnnN
 type instance Anno Id      = SrcSpanAnnN
 
 type IsSrcSpanAnn p a = ( Anno (IdGhcP p) ~ SrcSpanAnn' (EpAnn a),
+                          NoAnn a,
                           IsPass p)
 
 instance UnXRec (GhcPass p) where


=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -541,7 +541,7 @@ mkHsOpTy prom ty1 op ty2 = HsOpTy noAnn prom ty1 op ty2
 
 mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 mkHsAppTy t1 t2
-  = addCLocAA t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2))
+  = addCLocA t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2))
 
 mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
            -> LHsType (GhcPass p)
@@ -550,7 +550,7 @@ mkHsAppTys = foldl' mkHsAppTy
 mkHsAppKindTy :: LHsType (GhcPass p) -> LHsToken "@" (GhcPass p) -> LHsType (GhcPass p)
               -> LHsType (GhcPass p)
 mkHsAppKindTy ty at k
-  = addCLocAA ty k (HsAppKindTy noExtField ty at k)
+  = addCLocA ty k (HsAppKindTy noExtField ty at k)
 
 {-
 ************************************************************************


=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -232,14 +232,14 @@ mkLamCaseMatchGroup origin lam_variant (L l matches)
   = mkMatchGroup origin (L l $ map fixCtxt matches)
   where fixCtxt (L a match) = L a match{m_ctxt = LamAlt lam_variant}
 
-mkLocatedList :: Semigroup a
+mkLocatedList :: (Semigroup a, NoAnn an)
   => [GenLocated (SrcAnn a) e2] -> LocatedAn an [GenLocated (SrcAnn a) e2]
 mkLocatedList ms = case nonEmpty ms of
     Nothing -> noLocA []
     Just ms1 -> L (noAnnSrcSpan $ locA $ combineLocsA (NE.head ms1) (NE.last ms1)) ms
 
 mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkHsApp e1 e2 = addCLocAA e1 e2 (HsApp noComments e1 e2)
+mkHsApp e1 e2 = addCLocA e1 e2 (HsApp noComments e1 e2)
 
 mkHsAppWith
   :: (LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> HsExpr (GhcPass id) -> LHsExpr (GhcPass id))
@@ -250,7 +250,7 @@ mkHsAppWith mkLocated e1 e2 = mkLocated e1 e2 (HsApp noAnn e1 e2)
 
 mkHsApps
   :: LHsExpr (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
-mkHsApps = mkHsAppsWith addCLocAA
+mkHsApps = mkHsAppsWith addCLocA
 
 mkHsAppsWith
  :: (LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> HsExpr (GhcPass id) -> LHsExpr (GhcPass id))
@@ -260,7 +260,7 @@ mkHsAppsWith
 mkHsAppsWith mkLocated = foldl' (mkHsAppWith mkLocated)
 
 mkHsAppType :: LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn
-mkHsAppType e t = addCLocAA t_body e (HsAppType noExtField e noHsTok paren_wct)
+mkHsAppType e t = addCLocA t_body e (HsAppType noExtField e noHsTok paren_wct)
   where
     t_body    = hswc_body t
     paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }
@@ -1832,5 +1832,3 @@ rec_field_expl_impl rec_flds (RecFieldsDotDot { .. })
           = ImplicitFieldBinders
               { implFlBndr_field   = foExt fld
               , implFlBndr_binders = collectPatBinders CollNoDictBinders rhs }
-
-


=====================================
compiler/GHC/Parser.y
=====================================
@@ -4120,7 +4120,7 @@ sL1 :: HasLoc a => a -> b -> Located b
 sL1 x = sL (getHasLoc x)   -- #define sL1   sL (getLoc $1)
 
 {-# INLINE sL1a #-}
-sL1a :: HasLoc a =>  a -> b -> LocatedAn t b
+sL1a :: (HasLoc a, HasAnnotation t) =>  a -> b -> GenLocated t b
 sL1a x = sL (noAnnSrcSpan $ getHasLoc x)   -- #define sL1   sL (getLoc $1)
 
 {-# INLINE sL1n #-}
@@ -4132,7 +4132,7 @@ sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c
 sLL x y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)
 
 {-# INLINE sLLa #-}
-sLLa :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedAn t c
+sLLa :: (HasLoc a, HasLoc b, NoAnn t) => a -> b -> c -> LocatedAn t c
 sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)
 
 {-# INLINE sLLl #-}


=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -71,13 +71,14 @@ module GHC.Parser.Annotation (
   mapLocA,
   combineLocsA,
   combineSrcSpansA,
-  addCLocA, addCLocAA,
+  addCLocA,
 
   -- ** Constructing 'GenLocated' annotation types when we do not care
   -- about annotations.
-  noLocA, getLocA,
+  HasAnnotation(..),
+  noLocA,
+  getLocA,
   noSrcSpanA,
-  noAnnSrcSpan,
 
   -- ** Working with comments in annotations
   noComments, comment, addCommentsToSrcAnn, setCommentsSrcAnn,
@@ -994,15 +995,15 @@ la2na l = noAnnSrcSpan (locA l)
 
 -- |Helper function (temporary) during transition of names
 --  Discards any annotations
-la2la :: LocatedAn ann1 a2 -> LocatedAn ann2 a2
+la2la :: (NoAnn ann2) => LocatedAn ann1 a2 -> LocatedAn ann2 a2
 la2la (L la a) = L (noAnnSrcSpan (locA la)) a
 
 l2l :: SrcSpanAnn' a -> SrcAnn ann
-l2l l = noAnnSrcSpan (locA l)
+l2l l = SrcSpanAnn EpAnnNotUsed (locA l)
 
 -- |Helper function (temporary) during transition of names
 --  Discards any annotations
-na2la :: SrcSpanAnn' a -> SrcAnn ann
+na2la :: (NoAnn ann) => SrcSpanAnn' a -> SrcAnn ann
 na2la l = noAnnSrcSpan (locA l)
 
 reLoc :: LocatedAn a e -> Located e
@@ -1022,18 +1023,21 @@ reLocN (L (SrcSpanAnn _ l) a) = L l a
 
 -- ---------------------------------------------------------------------
 
-noLocA :: a -> LocatedAn an a
-noLocA = L (SrcSpanAnn EpAnnNotUsed noSrcSpan)
+class HasAnnotation e where
+  noAnnSrcSpan :: SrcSpan -> e
+
+instance (NoAnn ann) => HasAnnotation (SrcSpanAnn' (EpAnn ann)) where
+  noAnnSrcSpan l = SrcSpanAnn EpAnnNotUsed l
+
+noLocA :: (HasAnnotation e) => a -> GenLocated e a
+noLocA = L (noAnnSrcSpan noSrcSpan)
 
 getLocA :: GenLocated (SrcSpanAnn' a) e -> SrcSpan
 getLocA = getHasLoc
 
-noSrcSpanA :: SrcAnn ann
+noSrcSpanA :: (HasAnnotation e) => e
 noSrcSpanA = noAnnSrcSpan noSrcSpan
 
-noAnnSrcSpan :: SrcSpan -> SrcAnn ann
-noAnnSrcSpan l = SrcSpanAnn EpAnnNotUsed l
-
 -- ---------------------------------------------------------------------
 
 class NoAnn a where
@@ -1163,7 +1167,7 @@ epAnnComments (EpAnn _ _ cs) = cs
 sortLocatedA :: [GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e]
 sortLocatedA = sortBy (leftmost_smallest `on` getLocA)
 
-mapLocA :: (a -> b) -> GenLocated SrcSpan a -> GenLocated (SrcAnn ann) b
+mapLocA :: (NoAnn ann) => (a -> b) -> GenLocated SrcSpan a -> GenLocated (SrcAnn ann) b
 mapLocA f (L l a) = L (noAnnSrcSpan l) (f a)
 
 -- AZ:TODO: move this somewhere sane
@@ -1179,11 +1183,9 @@ combineSrcSpansA (SrcSpanAnn aa la) (SrcSpanAnn ab lb)
         SrcSpanAnn (EpAnn (widenAnchorR anc (realSrcSpan l)) an cs) l
 
 -- | Combine locations from two 'Located' things and add them to a third thing
-addCLocA :: GenLocated (SrcSpanAnn' a) e1 -> GenLocated SrcSpan e2 -> e3 -> GenLocated (SrcAnn ann) e3
-addCLocA a b c = L (noAnnSrcSpan $ combineSrcSpans (locA $ getLoc a) (getLoc b)) c
-
-addCLocAA :: GenLocated (SrcSpanAnn' a1) e1 -> GenLocated (SrcSpanAnn' a2) e2 -> e3 -> GenLocated (SrcAnn ann) e3
-addCLocAA a b c = L (noAnnSrcSpan $ combineSrcSpans (locA $ getLoc a) (locA $ getLoc b)) c
+addCLocA :: (HasLoc a, HasLoc b, HasAnnotation l)
+         => a -> b -> c -> GenLocated l c
+addCLocA a b c = L (noAnnSrcSpan $ combineSrcSpans (getHasLoc a) (getHasLoc b)) c
 
 -- ---------------------------------------------------------------------
 -- Utilities for manipulating EpAnnComments
@@ -1332,26 +1334,33 @@ instance Semigroup EpAnnComments where
   EpaCommentsBalanced cs1 as1 <> EpaCommentsBalanced cs2 as2 = EpaCommentsBalanced (cs1 ++ cs2) (as1++as2)
 
 
-instance NoAnn NoEpAnns where
-  noAnn = NoEpAnns
-
 instance Semigroup AnnListItem where
   (AnnListItem l1) <> (AnnListItem l2) = AnnListItem (l1 <> l2)
 
-instance NoAnn AnnListItem where
-  noAnn = AnnListItem []
-
-
 instance Semigroup (AnnSortKey tag) where
   NoAnnSortKey <> x = x
   x <> NoAnnSortKey = x
   AnnSortKey ls1 <> AnnSortKey ls2 = AnnSortKey (ls1 <> ls2)
 
+instance Monoid (AnnSortKey tag) where
+  mempty = NoAnnSortKey
+
+-- ---------------------------------------------------------------------
+-- NoAnn instances
+
+instance NoAnn NoEpAnns where
+  noAnn = NoEpAnns
+
+instance NoAnn AnnListItem where
+  noAnn = AnnListItem []
+
+instance NoAnn AnnContext where
+  noAnn = AnnContext Nothing [] []
+
 instance NoAnn AnnList where
   noAnn = AnnList Nothing Nothing Nothing [] []
 
-instance Monoid (AnnSortKey tag) where
-  mempty = NoAnnSortKey
+-- ---------------------------------------------------------------------
 
 instance NoAnn NameAnn where
   noAnn = NameAnnTrailing []


=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -714,7 +714,7 @@ checkCTupSize tup_size
 *                                                                      *
 ********************************************************************* -}
 
-wrapGenSpan :: a -> LocatedAn an a
+wrapGenSpan :: (NoAnn an) => a -> LocatedAn an a
 -- Wrap something in a "generatedSrcSpan"
 -- See Note [Rebindable syntax and HsExpansion]
 wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
@@ -742,10 +742,10 @@ genHsVar nm = HsVar noExtField $ wrapGenSpan nm
 genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
 genAppType expr ty = HsAppType noExtField (wrapGenSpan expr) noHsTok (mkEmptyWildCardBndrs (wrapGenSpan ty))
 
-genLHsLit :: HsLit GhcRn -> LocatedAn an (HsExpr GhcRn)
+genLHsLit :: (NoAnn an) => HsLit GhcRn -> LocatedAn an (HsExpr GhcRn)
 genLHsLit = wrapGenSpan . HsLit noAnn
 
-genHsIntegralLit :: IntegralLit -> LocatedAn an (HsExpr GhcRn)
+genHsIntegralLit :: (NoAnn an) => IntegralLit -> LocatedAn an (HsExpr GhcRn)
 genHsIntegralLit = genLHsLit . HsInt noExtField
 
 genHsTyLit :: FastString -> HsType GhcRn
@@ -767,11 +767,15 @@ genWildPat = wrapGenSpan $ WildPat noExtField
 genSimpleFunBind :: Name -> [LPat GhcRn]
                  -> LHsExpr GhcRn -> LHsBind GhcRn
 genSimpleFunBind fun pats expr
-  = L gen $ genFunBind (L gen fun)
-        [mkMatch (mkPrefixFunRhs (L gen fun)) pats expr
+  = L genA $ genFunBind (L genN fun)
+        [mkMatch (mkPrefixFunRhs (L genN fun)) pats expr
                  emptyLocalBinds]
   where
-    gen = noAnnSrcSpan generatedSrcSpan
+    genA :: SrcSpanAnnA
+    genA = noAnnSrcSpan generatedSrcSpan
+
+    genN :: SrcSpanAnnN
+    genN = noAnnSrcSpan generatedSrcSpan
 
 genFunBind :: LocatedN Name -> [LMatch GhcRn (LHsExpr GhcRn)]
            -> HsBind GhcRn


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -142,13 +142,13 @@ getL = CvtM (\_ loc -> Right (loc,loc))
 setL :: SrcSpan -> CvtM ()
 setL loc = CvtM (\_ _ -> Right (loc, ()))
 
-returnLA :: e -> CvtM (LocatedAn ann e)
+returnLA :: (NoAnn ann) => e -> CvtM (LocatedAn ann e)
 returnLA x = CvtM (\_ loc -> Right (loc, L (noAnnSrcSpan loc) x))
 
 returnJustLA :: a -> CvtM (Maybe (LocatedA a))
 returnJustLA = fmap Just . returnLA
 
-wrapParLA :: (LocatedAn ann a -> b) -> a -> CvtM b
+wrapParLA :: (NoAnn ann) => (LocatedAn ann a -> b) -> a -> CvtM b
 wrapParLA add_par x = CvtM (\_ loc -> Right (loc, add_par (L (noAnnSrcSpan loc) x)))
 
 wrapMsg :: ThingBeingConverted -> CvtM' ConversionFailReason a -> CvtM' RunSpliceFailReason a


=====================================
hadrian/src/Rules/SourceDist.hs
=====================================
@@ -184,7 +184,7 @@ prepareTree dest = do
         , (stage0InTree , compiler,      "GHC/Parser.y",       "GHC/Parser.hs")
         , (stage0InTree , compiler,      "GHC/Parser/Lexer.x", "GHC/Parser/Lexer.hs")
         , (stage0InTree , compiler,      "GHC/Parser/HaddockLex.x", "GHC/Parser/HaddockLex.hs")
-        , (stage0InTree , hpcBin,        "src/HpcParser.y",    "src/HpcParser.hs")
+        , (stage0InTree , hpcBin,        "src/Trace/Hpc/Parser.y", "src/Trace/Hpc/Parser.hs")
         , (stage0InTree , genprimopcode, "Parser.y",           "Parser.hs")
         , (stage0InTree , genprimopcode, "Lexer.x",            "Lexer.hs")
         , (stage0InTree , cabalSyntax  , "src/Distribution/Fields/Lexer.x",  "src/Distribution/Fields/Lexer.hs")


=====================================
libraries/base/GHC/IO/FD.hs
=====================================
@@ -82,13 +82,19 @@ clampReadSize  = min 0x7ffff000
 data FD = FD {
   fdFD :: {-# UNPACK #-} !CInt,
 #if defined(mingw32_HOST_OS)
-  -- On Windows, a socket file descriptor needs to be read and written
+  -- | On Windows, a socket file descriptor needs to be read and written
   -- using different functions (send/recv).
   fdIsSocket_ :: {-# UNPACK #-} !Int
 #else
-  -- On Unix we need to know whether this FD has O_NONBLOCK set.
-  -- If it has, then we can use more efficient routines to read/write to it.
-  -- It is always safe for this to be off.
+  -- | On Unix we need to know whether this 'FD' has @O_NONBLOCK@ set.
+  -- If it has, then we can use more efficient routines (namely, unsafe FFI)
+  -- to read/write to it. Otherwise safe FFI is used.
+  --
+  -- @O_NONBLOCK@ has no effect on regular files and block devices at the moment,
+  -- thus this flag should be off for them. While reading from a file cannot
+  -- block indefinitely (as opposed to reading from a socket or a pipe), it can block
+  -- the entire runtime for a "brief" moment of time: you cannot read a file from
+  -- a floppy drive or network share without delay.
   fdIsNonBlocking :: {-# UNPACK #-} !Int
 #endif
  }
@@ -197,6 +203,9 @@ openFileWith
   :: FilePath -- ^ file to open
   -> IOMode   -- ^ mode in which to open the file
   -> Bool     -- ^ open the file in non-blocking mode?
+              --   This has no effect on regular files and block devices:
+              --   they are always opened in blocking mode.
+              --   See 'fdIsNonBlocking' for more discussion.
   -> (FD -> IODeviceType -> IO r) -- ^ @act1@: An action to perform
                     -- on the file descriptor with the masking state
                     -- restored and an exception handler that closes
@@ -332,7 +341,11 @@ mkFD fd iomode mb_stat is_socket is_nonblock = do
 
     return (FD{ fdFD = fd,
 #if !defined(mingw32_HOST_OS)
-                fdIsNonBlocking = fromEnum is_nonblock
+                -- As https://man7.org/linux/man-pages/man2/open.2.html explains,
+                -- O_NONBLOCK has no effect on regular files and block devices;
+                -- utilities inspecting fdIsNonBlocking (such as readRawBufferPtr)
+                -- should not be tricked to think otherwise.
+                fdIsNonBlocking = fromEnum (is_nonblock && fd_type /= RegularFile && fd_type /= RawDevice)
 #else
                 fdIsSocket_ = fromEnum is_socket
 #endif
@@ -452,11 +465,19 @@ dup2 fd fdto = do
 
 setNonBlockingMode :: FD -> Bool -> IO FD
 setNonBlockingMode fd set = do
-  setNonBlockingFD (fdFD fd) set
+  -- This mirrors the behaviour of mkFD:
+  -- O_NONBLOCK has no effect on regular files and block devices;
+  -- utilities inspecting fdIsNonBlocking (such as readRawBufferPtr)
+  -- should not be tricked to think otherwise.
+  is_nonblock <- if set then do
+    (fd_type, _, _) <- fdStat (fdFD fd)
+    pure $ fd_type /= RegularFile && fd_type /= RawDevice
+    else pure False
+  setNonBlockingFD (fdFD fd) is_nonblock
 #if defined(mingw32_HOST_OS)
   return fd
 #else
-  return fd{ fdIsNonBlocking = fromEnum set }
+  return fd{ fdIsNonBlocking = fromEnum is_nonblock }
 #endif
 
 ready :: FD -> Bool -> Int -> IO Bool


=====================================
libraries/base/changelog.md
=====================================
@@ -5,6 +5,9 @@
   * Add a `RULE` to `Prelude.lookup`, allowing it to participate in list fusion ([CLC proposal #174](https://github.com/haskell/core-libraries-committee/issues/175))
   * The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))
   * Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
+  * Fix `fdIsNonBlocking` to always be `0` for regular files and block devices on unix, regardless of `O_NONBLOCK`
+  * Always use `safe` call to `read` for regular files and block devices on unix if the RTS is multi-threaded, regardless of `O_NONBLOCK`.
+    ([CLC proposal #166](https://github.com/haskell/core-libraries-committee/issues/166))
 
 ## 4.19.0.0 *TBA*
   * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`.


=====================================
libraries/unix
=====================================
@@ -1 +1 @@
-Subproject commit 3f0d217b5b3de5ccec54154d5cd5c7b0d07708df
+Subproject commit 5211c230903aee8c09485e8246993e2a1eb74563


=====================================
testsuite/tests/hpc/T17073.stdout
=====================================
@@ -7,7 +7,7 @@
 100% alternatives used (0/0)
 100% local declarations used (0/0)
 100% top-level declarations used (1/1)
-hpc tools, version 0.68
+hpc tools, version 0.69
 Writing: Main.hs.html
 Writing: hpc_index.html
 Writing: hpc_index_fun.html


=====================================
utils/check-exact/Orphans.hs
=====================================
@@ -62,9 +62,6 @@ instance NoAnn AddEpAnn where
 instance NoAnn AnnKeywordId where
   noAnn = Annlarrowtail  {- gotta pick one -}
 
-instance NoAnn AnnContext where
-  noAnn = AnnContext Nothing [] []
-
 instance NoAnn EpAnnSumPat where
   noAnn = EpAnnSumPat noAnn  noAnn  noAnn
 


=====================================
utils/check-exact/Utils.hs
=====================================
@@ -371,9 +371,9 @@ setAnchorHsModule hsmod anc cs = hsmod { hsmodExt = (hsmodExt hsmod) {hsmodAnn =
 
 -- |Version of l2l that preserves the anchor, immportant if it has an
 -- updated AnchorOperation
-moveAnchor :: Monoid b => SrcAnn a -> SrcAnn b
+moveAnchor :: NoAnn b => SrcAnn a -> SrcAnn b
 moveAnchor (SrcSpanAnn EpAnnNotUsed l) = noAnnSrcSpan l
-moveAnchor (SrcSpanAnn (EpAnn anc _ cs) l) = SrcSpanAnn (EpAnn anc mempty cs) l
+moveAnchor (SrcSpanAnn (EpAnn anc _ cs) l) = SrcSpanAnn (EpAnn anc noAnn cs) l
 
 -- ---------------------------------------------------------------------
 


=====================================
utils/hpc
=====================================
@@ -1 +1 @@
-Subproject commit 2d75eb33d4c179b1c21000d32c2906ad273de0de
+Subproject commit 4b46380a06c16e38a5b9d623ab85538ee4b2319d



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36ef67208607261d445263e9579355b4fc57ca58...a703f29084c7e4580bf9f55a5b8ed5a6d87a5566

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36ef67208607261d445263e9579355b4fc57ca58...a703f29084c7e4580bf9f55a5b8ed5a6d87a5566
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/20231009/32ca9855/attachment-0001.html>


More information about the ghc-commits mailing list