[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: perf tests: Move comments into new `Note [Sensitivity to unique increment]` (#19414)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Nov 30 15:18:07 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
03a559ed by Sebastian Graf at 2023-11-30T10:17:15-05:00
perf tests: Move comments into new `Note [Sensitivity to unique increment]` (#19414)
And additionally to T12545, link from T8095, T13386 to this new Note.
- - - - -
d3815491 by Alan Zimmerman at 2023-11-30T10:17:15-05:00
EPA: EpaDelta for comment has no comments
EpaLocation is used to position things. It has two constructors,
EpaSpan holding a SrcSpan, and EpaDelta with a delta position and a
possible list of comments. The comment list is needed because the
location in EpaDelta has no absolute information to decide which
comments should be emitted before them when printing.
But it is also used for specifying the position of a comment. To
prevent the absurdity of a comment position having a list of comments
in it, we make EpaLocation parameterisable, using comments for the
normal case and a constant for within comments.
Updates haddock submodule.
aarch64-darwin
Metric Decrease:
MultiLayerModulesTH_OneShot
- - - - -
a54f765e by Krzysztof Gogolewski at 2023-11-30T10:17:16-05:00
Kind-check body of a required forall
We now require that in 'forall a -> ty', ty has kind TYPE r for some r.
Fixes #24176
- - - - -
17 changed files:
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Tc/Gen/HsType.hs
- testsuite/tests/dependent/should_fail/T16326_Fail12.stderr
- testsuite/tests/perf/compiler/T12545.hs
- testsuite/tests/perf/compiler/T13386.hs
- testsuite/tests/perf/compiler/T8095.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/printer/Test20297.stdout
- + testsuite/tests/vdq-rta/should_fail/T24176.hs
- + testsuite/tests/vdq-rta/should_fail/T24176.stderr
- testsuite/tests/vdq-rta/should_fail/all.T
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Types.hs
- utils/check-exact/Utils.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -13,7 +13,7 @@ module GHC.Parser.Annotation (
-- * In-tree Exact Print Annotations
AddEpAnn(..),
- EpaLocation(..), epaLocationRealSrcSpan,
+ EpaLocation, EpaLocation'(..), epaLocationRealSrcSpan,
TokenLocation(..),
getTokenSrcSpan,
DeltaPos(..), deltaPos, getDeltaLine,
@@ -26,7 +26,8 @@ module GHC.Parser.Annotation (
-- ** Comments in Annotations
- EpAnnComments(..), LEpaComment, emptyComments,
+ EpAnnComments(..), LEpaComment, NoCommentsLocation, NoComments(..), emptyComments,
+ epaToNoCommentsLocation, noCommentsToEpaLocation,
getFollowingComments, setFollowingComments, setPriorComments,
EpAnnCO,
@@ -402,9 +403,26 @@ data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Eq)
-- 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 = EpaSpan !SrcSpan
- | EpaDelta !DeltaPos ![LEpaComment]
- deriving (Data,Eq,Show)
+
+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
+epaToNoCommentsLocation (EpaDelta _ _ ) = panic "epaToNoCommentsLocation"
+
+noCommentsToEpaLocation :: NoCommentsLocation -> EpaLocation
+noCommentsToEpaLocation (EpaSpan ss) = EpaSpan ss
+noCommentsToEpaLocation (EpaDelta dp NoComments) = EpaDelta dp []
-- | Tokens embedded in the AST have an EpaLocation, unless they come from
-- generated code (e.g. by TH).
@@ -454,7 +472,10 @@ epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan (EpaSpan (RealSrcSpan r _)) = r
epaLocationRealSrcSpan _ = panic "epaLocationRealSrcSpan"
-instance Outputable EpaLocation where
+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
@@ -517,18 +538,18 @@ data EpAnn ann
-- that relationship is tracked in the 'anchor_op' instead.
type Anchor = EpaLocation -- Transitional
-anchor :: Anchor -> RealSrcSpan
+anchor :: (EpaLocation' a) -> RealSrcSpan
anchor (EpaSpan (RealSrcSpan r _)) = r
anchor _ = panic "anchor"
-spanAsAnchor :: SrcSpan -> Anchor
+spanAsAnchor :: SrcSpan -> (EpaLocation' a)
spanAsAnchor ss = EpaSpan ss
-realSpanAsAnchor :: RealSrcSpan -> Anchor
+realSpanAsAnchor :: RealSrcSpan -> (EpaLocation' a)
realSpanAsAnchor s = EpaSpan (RealSrcSpan s Strict.Nothing)
-noSpanAnchor :: Anchor
-noSpanAnchor = EpaDelta (SameLine 0) []
+noSpanAnchor :: (NoAnn a) => (EpaLocation' a)
+noSpanAnchor = EpaDelta (SameLine 0) noAnn
-- ---------------------------------------------------------------------
@@ -546,7 +567,7 @@ data EpAnnComments = EpaComments
, followingComments :: ![LEpaComment] }
deriving (Data, Eq)
-type LEpaComment = GenLocated Anchor EpaComment
+type LEpaComment = GenLocated NoCommentsLocation EpaComment
emptyComments :: EpAnnComments
emptyComments = EpaComments []
@@ -1333,7 +1354,7 @@ instance Outputable DeltaPos where
ppr (SameLine c) = text "SameLine" <+> ppr c
ppr (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c
-instance Outputable (GenLocated Anchor EpaComment) where
+instance Outputable (GenLocated NoCommentsLocation EpaComment) where
ppr (L l c) = text "L" <+> ppr l <+> ppr c
instance Outputable EpAnnComments where
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -1178,17 +1178,30 @@ tc_hs_type mode (HsOpTy _ _ ty1 (L _ op) ty2) exp_kind
= tc_fun_type mode (HsUnrestrictedArrow noHsUniTok) ty1 ty2 exp_kind
--------- Foralls
-tc_hs_type mode (HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind
- = do { (tv_bndrs, ty') <- tcTKTelescope mode tele $
- tc_lhs_type mode ty exp_kind
+tc_hs_type mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind
+ | HsForAllInvis{} <- tele
+ = tc_hs_forall_ty tele ty exp_kind
+ -- For an invisible forall, we allow the body to have
+ -- an arbitrary kind (hence exp_kind above).
+ -- See Note [Body kind of a HsForAllTy]
+
+ | HsForAllVis{} <- tele
+ = do { ek <- newOpenTypeKind
+ ; r <- tc_hs_forall_ty tele ty ek
+ ; checkExpectedKind t r ek exp_kind }
+ -- For a visible forall, we require that the body is of kind TYPE r.
+ -- See Note [Body kind of a HsForAllTy]
+
+ where
+ tc_hs_forall_ty tele ty ek
+ = do { (tv_bndrs, ty') <- tcTKTelescope mode tele $
+ tc_lhs_type mode ty ek
-- Pass on the mode from the type, to any wildcards
-- in kind signatures on the forall'd variables
-- e.g. f :: _ -> Int -> forall (a :: _). blah
- -- Why exp_kind? See Note [Body kind of a HsForAllTy]
- -- Do not kind-generalise here! See Note [Kind generalisation]
-
- ; return (mkForAllTys tv_bndrs ty') }
+ -- Do not kind-generalise here! See Note [Kind generalisation]
+ ; return (mkForAllTys tv_bndrs ty') }
tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind
| null (unLoc ctxt)
@@ -2042,25 +2055,23 @@ examples.
Note [Body kind of a HsForAllTy]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The body of a forall is usually a type, but in principle
-there's no reason to prohibit *unlifted* types.
-In fact, GHC can itself construct a function with an
-unboxed tuple inside a for-all (via CPR analysis; see
+The body of a forall is usually a type.
+Because of representation polymorphism, it can be a TYPE r, for any r.
+(In fact, GHC can itself construct a function with an
+unboxed tuple inside a for-all via CPR analysis; see
typecheck/should_compile/tc170).
-Moreover in instance heads we get forall-types with
-kind Constraint.
-
-It's tempting to check that the body kind is (TYPE _). But this is
-wrong. For example:
+A forall can also be used in an instance head, then the body should
+be a constraint.
- class C a b
- newtype N = Mk Foo deriving (C a)
+Right now, we do not have any easy way to enforce that a type is
+either a TYPE something or CONSTRAINT something, so we accept any kind.
+This is unsound (#22063). We could fix this by implementing a TypeLike
+predicate, see #20000.
-We're doing newtype-deriving for C. But notice how `a` isn't in scope in
-the predicate `C a`. So we quantify, yielding `forall a. C a` even though
-`C a` has kind `* -> Constraint`. The `forall a. C a` is a bit cheeky, but
-convenient. Bottom line: don't check for (TYPE _) here.
+For a forall with a required argument, we do not allow constraints;
+e.g. forall a -> Eq a is invalid. Therefore, we can enforce that the body
+is a TYPE something in this case (#24176).
Note [Body kind of a HsQualTy]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
testsuite/tests/dependent/should_fail/T16326_Fail12.stderr
=====================================
@@ -1,8 +1,8 @@
-T16326_Fail12.hs:6:1: error: [GHC-51580]
- • Illegal visible, dependent quantification in the type of a term:
- forall a -> Show a
- • In the context: forall a -> Show a
- While checking the super-classes of class ‘C’
- In the class declaration for ‘C’
- Suggested fix: Perhaps you intended to use RequiredTypeArguments
+T16326_Fail12.hs:6:8: error: [GHC-83865]
+ • Expected a constraint, but ‘forall a -> Show a’ is a type
+ • In the class declaration for ‘C’
+
+T16326_Fail12.hs:6:20: error: [GHC-83865]
+ • Expected a type, but ‘Show a’ is a constraint
+ • In the class declaration for ‘C’
=====================================
testsuite/tests/perf/compiler/T12545.hs
=====================================
@@ -15,6 +15,29 @@ type instance ElemsOf A = [ T1, T2, T3, T4, T5, T6, T7, T8
, T25, T26, T27, T28, T29, T30, T31, T32
]
+{- Note [Sensitivity to unique increment]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+T12545 is sensitive to -dunique-increments changes, see #19414. I've seen
+variations of as much as 4.8% by playing with that parameter.
+
+The issue with this test is that it does too little so is very sensitive to
+any small variations during initialisation and in particular populating the
+initial environments with wired-in things. Therefore it has a very high change
+threshold so we catch if it regresses a lot but don't worry if it regresses a little.
+
+You can measure the variance by running T12545.measure.sh.
+
+Whenever we identify such a test (T8095 being another example), we leave a link
+to this Note in the source code of the test *and* in the corresponding all.T,
+detailing the spread as measured by adjusting T12545.measure.sh.
+For example,
+
+# See Note [Sensitivity to unique increment] in T12545.hs; spread was 4.8%
+
+and then double the spread to come up with a stable acceptance threshold (e.g.,
+10%).
+-}
+
data T1; instance ElemOf A T1 where
data T2; instance ElemOf A T2 where
data T3; instance ElemOf A T3 where
=====================================
testsuite/tests/perf/compiler/T13386.hs
=====================================
@@ -1,6 +1,6 @@
{-# LANGUAGE DataKinds, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
{-# OPTIONS_GHC -O0 -freduction-depth=500 #-}
-
+-- Subject to Note [Sensitivity to unique increment] with spread of 1.5%
module T13386 where
import GHC.TypeLits
=====================================
testsuite/tests/perf/compiler/T8095.hs
=====================================
@@ -1,5 +1,6 @@
{-# OPTIONS_GHC -freduction-depth=1000 #-}
{-# LANGUAGE TypeOperators,DataKinds,KindSignatures,TypeFamilies,PolyKinds,UndecidableInstances #-}
+-- Subject to Note [Sensitivity to unique increment] with spread of 1.7%
import GHC.TypeLits
data Nat1 = Zero | Succ Nat1
type family Replicate1 (n :: Nat1) (x::a) :: [a]
@@ -16,4 +17,3 @@ instance (xs ~ Replicate1 ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ
f X = Y
f Y = X
test1 = f (X :: Data ( Replicate1 ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Succ ( Zero ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) () ))
-
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -167,14 +167,18 @@ test('T9872d',
],
compile,
[''])
+# Since major improvements to T8095 in in
+# 4bf9fa0f216bb294c1bd3644363b008a8643a653 it is subject to
+# Note [Sensitivity to unique increment] in T12545.hs; spread was 1.7%
test ('T8095',
[ only_ways(['normal']),
- collect_compiler_stats('bytes allocated',2) ],
+ collect_compiler_stats('bytes allocated',4) ],
compile,
['-v0 -O'])
+# See Note [Sensitivity to unique increment] in T12545.hs; spread was 1.5%
test ('T13386',
[ only_ways(['normal']),
- collect_compiler_stats('bytes allocated',1) ],
+ collect_compiler_stats('bytes allocated',3) ],
compile,
['-v0 -O0'])
@@ -261,15 +265,7 @@ test('T12234',
compile,
[''])
-# T12545 is sensitive to -dunique-increments changes, see #19414. I've seen
-# variations of as much as 4.8% by playing with that parameter,
-#
-# The issue with the test is that it does too little so is very sensitive to
-# any small variations during initialisation and in particular populating the
-# initial environments with wired-in things. Therefore it has a very high change
-# threshold so we catch if it regresses a lot but don't worry if it regresses a little.
-#
-# You can measure the variance by running T12545.measure.sh.
+# See Note [Sensitivity to unique increment] in T12545.hs; spread was 4.8%
test('T12545',
[ only_ways(['normal']),
collect_compiler_stats('bytes allocated', 10), #
=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -17,7 +17,8 @@
{ Test20297.hs:11:22-26 })))
(EpaCommentsBalanced
[(L
- (EpaSpan { Test20297.hs:1:1-33 })
+ (EpaSpan
+ { Test20297.hs:1:1-33 })
(EpaComment
(EpaBlockComment
"{-# OPTIONS -ddump-parsed-ast #-}")
@@ -114,7 +115,8 @@
(AddEpAnn AnnEqual (EpaSpan { Test20297.hs:5:5 })))
(EpaComments
[(L
- (EpaSpan { Test20297.hs:6:3-13 })
+ (EpaSpan
+ { Test20297.hs:6:3-13 })
(EpaComment
(EpaLineComment
"-- comment0")
@@ -162,7 +164,8 @@
[])
(EpaComments
[(L
- (EpaSpan { Test20297.hs:7:9-19 })
+ (EpaSpan
+ { Test20297.hs:7:9-19 })
(EpaComment
(EpaLineComment
"-- comment1")
@@ -267,7 +270,8 @@
[])
(EpaComments
[(L
- (EpaSpan { Test20297.hs:10:9-19 })
+ (EpaSpan
+ { Test20297.hs:10:9-19 })
(EpaComment
(EpaLineComment
"-- comment2")
@@ -436,7 +440,8 @@
{ Test20297.ppr.hs:9:20-24 })))
(EpaCommentsBalanced
[(L
- (EpaSpan { Test20297.ppr.hs:1:1-33 })
+ (EpaSpan
+ { Test20297.ppr.hs:1:1-33 })
(EpaComment
(EpaBlockComment
"{-# OPTIONS -ddump-parsed-ast #-}")
=====================================
testsuite/tests/vdq-rta/should_fail/T24176.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE QuantifiedConstraints, RequiredTypeArguments #-}
+module T24176 where
+
+f :: (forall a -> Eq a) => a
+f = f
=====================================
testsuite/tests/vdq-rta/should_fail/T24176.stderr
=====================================
@@ -0,0 +1,8 @@
+
+T24176.hs:4:7: error: [GHC-83865]
+ • Expected a constraint, but ‘forall a -> Eq a’ is a type
+ • In the type signature: f :: (forall a -> Eq a) => a
+
+T24176.hs:4:19: error: [GHC-83865]
+ • Expected a type, but ‘Eq a’ is a constraint
+ • In the type signature: f :: (forall a -> Eq a) => a
=====================================
testsuite/tests/vdq-rta/should_fail/all.T
=====================================
@@ -14,4 +14,5 @@ test('T22326_fail_patsyn', normal, compile_fail, [''])
test('T22326_fail_match', normal, compile_fail, [''])
test('T23738_fail_wild', normal, compile_fail, [''])
test('T23738_fail_implicit_tv', normal, compile_fail, [''])
-test('T23738_fail_var', normal, compile_fail, [''])
\ No newline at end of file
+test('T23738_fail_var', normal, compile_fail, [''])
+test('T24176', normal, compile_fail, [''])
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -619,7 +619,7 @@ annotationsToComments (EpAnn anc a cs) l kws = do
go :: ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])
go acc [] = acc
go (cs',ans) ((AddEpAnn k ss) : ls)
- | Set.member k keywords = go ((mkKWComment k ss):cs', ans) ls
+ | Set.member k keywords = go ((mkKWComment k (epaToNoCommentsLocation ss)):cs', ans) ls
| otherwise = go (cs', (AddEpAnn k ss):ans) ls
-- ---------------------------------------------------------------------
@@ -677,7 +677,7 @@ printStringAtRsC capture pa str = do
NoCaptureComments -> return []
debugM $ "printStringAtRsC:cs'=" ++ show cs'
debugM $ "printStringAtRsC:p'=" ++ showAst p'
- debugM $ "printStringAtRsC: (EpaDelta p' [])=" ++ showAst (EpaDelta p' [])
+ debugM $ "printStringAtRsC: (EpaDelta p' [])=" ++ showAst (EpaDelta p' NoComments)
debugM $ "printStringAtRsC: (EpaDelta p' (map comment2LEpaComment cs'))=" ++ showAst (EpaDelta p' (map comment2LEpaComment cs'))
return (EpaDelta p' (map comment2LEpaComment cs'))
@@ -1365,14 +1365,14 @@ printCommentsBefore :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()
printCommentsBefore ss = do
cs <- commentAllocationBefore ss
debugM $ "printCommentsBefore: (ss): " ++ showPprUnsafe (rs2range ss)
- -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentAnchor cs)
+ -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentLoc cs)
mapM_ printOneComment cs
printCommentsIn :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()
printCommentsIn ss = do
cs <- commentAllocationIn ss
debugM $ "printCommentsIn: (ss): " ++ showPprUnsafe (rs2range ss)
- -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentAnchor cs)
+ -- debugM $ "printComments: (ss,comment locations): " ++ showPprUnsafe (rs2range ss,map commentLoc cs)
mapM_ printOneComment cs
debugM $ "printCommentsIn:done"
@@ -1423,12 +1423,12 @@ updateAndApplyComment (Comment str anc pp mo) dp = do
_ -> dp''
op' = case dp' of
SameLine n -> if n >= 0
- then EpaDelta dp' []
- else EpaDelta dp []
- _ -> EpaDelta dp' []
- anc' = if str == "" && op' == EpaDelta (SameLine 0) [] -- EOF comment
- then EpaDelta dp []
- else EpaDelta dp []
+ then EpaDelta dp' NoComments
+ else EpaDelta dp NoComments
+ _ -> EpaDelta dp' NoComments
+ anc' = if str == "" && op' == EpaDelta (SameLine 0) NoComments -- EOF comment
+ then EpaDelta dp NoComments
+ else EpaDelta dp NoComments
-- ---------------------------------------------------------------------
=====================================
utils/check-exact/Main.hs
=====================================
@@ -68,6 +68,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/
-- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl4.hs" (Just addLocaLDecl4)
-- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl5.hs" (Just addLocaLDecl5)
-- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl6.hs" (Just addLocaLDecl6)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddClassMethod.hs" (Just addClassMethod)
-- "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" (Just rmDecl1)
-- "../../testsuite/tests/ghc-api/exactprint/RmDecl2.hs" (Just rmDecl2)
-- "../../testsuite/tests/ghc-api/exactprint/RmDecl3.hs" (Just rmDecl3)
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -283,8 +283,9 @@ setEntryDP (L (EpAnn (EpaDelta d csd) an cs) a) dp
(dp0,c') = go h
in
(dp0, c':t, EpaCommentsBalanced [] ts)
+ go :: GenLocated NoCommentsLocation e -> (DeltaPos, GenLocated NoCommentsLocation e)
go (L (EpaDelta _ c0) c) = (d, L (EpaDelta dp c0) c)
- go (L (EpaSpan _) c) = (d, L (EpaDelta dp []) c)
+ go (L (EpaSpan _) c) = (d, L (EpaDelta dp NoComments) c)
setEntryDP (L (EpAnn (EpaSpan (RealSrcSpan r _)) an cs) a) dp
= case sortEpaComments (priorComments cs) of
[] ->
@@ -293,7 +294,7 @@ setEntryDP (L (EpAnn (EpaSpan (RealSrcSpan r _)) an cs) a) dp
L (EpAnn (EpaDelta edp csd) an cs'') a
where
cs'' = setPriorComments cs []
- csd = L (EpaDelta dp []) c:cs'
+ csd = L (EpaDelta dp NoComments) c:cs'
lc = last $ (L ca c:cs')
delta = case getLoc lc of
EpaSpan (RealSrcSpan rr _) -> ss2delta (ss2pos rr) r
=====================================
utils/check-exact/Types.hs
=====================================
@@ -31,7 +31,7 @@ data Rigidity = NormalLayout | RigidLayout deriving (Eq, Ord, Show)
data Comment = Comment
{
commentContents :: !String -- ^ The contents of the comment including separators
- , commentAnchor :: !Anchor
+ , commentLoc :: !NoCommentsLocation
, commentPriorTok :: !RealSrcSpan
, commentOrigin :: !(Maybe AnnKeywordId) -- ^ We sometimes turn syntax into comments in order to process them properly.
}
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -186,7 +186,7 @@ isPointSrcSpan ss = spanLength ss == 0
-- does not already have one.
commentOrigDelta :: LEpaComment -> LEpaComment
commentOrigDelta (L (EpaSpan (RealSrcSpan la _)) (GHC.EpaComment t pp))
- = (L (EpaDelta dp []) (GHC.EpaComment t pp))
+ = (L (EpaDelta dp NoComments) (GHC.EpaComment t pp))
`debug` ("commentOrigDelta: (la, pp, r,c, dp)=" ++ showAst (la, pp, r,c, dp))
where
(r,c) = ss2posEnd pp
@@ -253,7 +253,7 @@ ghcCommentText (L _ (GHC.EpaComment (EpaBlockComment s) _)) = s
tokComment :: LEpaComment -> [Comment]
tokComment t@(L lt c) =
case c of
- (GHC.EpaComment (EpaDocComment dc) pt) -> hsDocStringComments lt pt dc
+ (GHC.EpaComment (EpaDocComment dc) pt) -> hsDocStringComments (noCommentsToEpaLocation lt) pt dc
_ -> [mkComment (normaliseCommentText (ghcCommentText t)) lt (ac_prior_tok c)]
hsDocStringComments :: Anchor -> RealSrcSpan -> GHC.HsDocString -> [Comment]
@@ -268,9 +268,9 @@ hsDocStringComments _ pt (MultiLineDocString dec (x :| xs)) =
in
(Comment str (spanAsAnchor lx) pt Nothing : docChunk (rs lx) (map dedentDocChunk xs))
hsDocStringComments anc pt (NestedDocString dec@(HsDocStringNamed _) (L _ chunk))
- = [Comment ("{- " ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") anc pt Nothing ]
+ = [Comment ("{- " ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") (epaToNoCommentsLocation anc) pt Nothing ]
hsDocStringComments anc pt (NestedDocString dec (L _ chunk))
- = [Comment ("{-" ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") anc pt Nothing ]
+ = [Comment ("{-" ++ printDecorator dec ++ unpackHDSC chunk ++ "-}") (epaToNoCommentsLocation anc) pt Nothing ]
hsDocStringComments _ _ (GeneratedDocString _) = [] -- Should not appear in user-written code
@@ -301,11 +301,11 @@ mkEpaComments priorCs postCs
comment2LEpaComment :: Comment -> LEpaComment
comment2LEpaComment (Comment s anc r _mk) = mkLEpaComment s anc r
-mkLEpaComment :: String -> Anchor -> RealSrcSpan -> LEpaComment
-mkLEpaComment s anc r = (L anc (GHC.EpaComment (EpaLineComment s) r))
+mkLEpaComment :: String -> NoCommentsLocation -> RealSrcSpan -> LEpaComment
+mkLEpaComment s loc r = (L loc (GHC.EpaComment (EpaLineComment s) r))
-mkComment :: String -> Anchor -> RealSrcSpan -> Comment
-mkComment c anc r = Comment c anc r Nothing
+mkComment :: String -> NoCommentsLocation -> RealSrcSpan -> Comment
+mkComment c loc r = Comment c loc r Nothing
-- Windows comments include \r in them from the lexer.
normaliseCommentText :: String -> String
@@ -328,11 +328,11 @@ sortEpaComments cs = sortBy cmp cs
cmp (L l1 _) (L l2 _) = compare (ss2pos $ anchor l1) (ss2pos $ anchor l2)
-- | Makes a comment which originates from a specific keyword.
-mkKWComment :: AnnKeywordId -> EpaLocation -> Comment
+mkKWComment :: AnnKeywordId -> NoCommentsLocation -> Comment
mkKWComment kw (EpaSpan (RealSrcSpan ss mb))
= Comment (keywordToString kw) (EpaSpan (RealSrcSpan ss mb)) ss (Just kw)
mkKWComment kw (EpaSpan (UnhelpfulSpan _))
- = Comment (keywordToString kw) (EpaDelta (SameLine 0) []) placeholderRealSpan (Just kw)
+ = Comment (keywordToString kw) (EpaDelta (SameLine 0) NoComments) placeholderRealSpan (Just kw)
mkKWComment kw (EpaDelta dp cs)
= Comment (keywordToString kw) (EpaDelta dp cs) placeholderRealSpan (Just kw)
@@ -481,7 +481,7 @@ hsDeclsClassDecl dec = case dec of
tcdATs = ats, tcdATDefs = at_defs
} -> map snd decls
where
- srs :: (HasLoc a) => a -> RealSrcSpan
+ srs :: EpAnn a -> RealSrcSpan
srs a = realSrcSpan $ locA a
decls
= orderedDecls sortKey $ Map.fromList
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit f9f25507bf48a8b05f21759744eddc93741fd10a
+Subproject commit a7eae7da6868b22dc7109142475b228c60509812
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b88177e273b98b5a2ac6c782f9f13e43b40ed4c...a54f765ee0e4dd6368ce1790267c23cd55eea619
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b88177e273b98b5a2ac6c782f9f13e43b40ed4c...a54f765ee0e4dd6368ce1790267c23cd55eea619
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/20231130/08d02e79/attachment-0001.html>
More information about the ghc-commits
mailing list