[Git][ghc/ghc][wip/T24040-ghci-timeout] 8 commits: distrib: Rediscover otool and install_name_tool on Darwin
Hassan Al-Awwadi (@hassan.awwadi)
gitlab at gitlab.haskell.org
Sun Dec 3 10:38:04 UTC 2023
Hassan Al-Awwadi pushed to branch wip/T24040-ghci-timeout at Glasgow Haskell Compiler / GHC
Commits:
292983c8 by Ben Gamari at 2023-11-28T22:44:28-05:00
distrib: Rediscover otool and install_name_tool on Darwin
In the bindist configure script we must rediscover the `otool` and
`install_name_tool`s since they may be different from the build
environment.
Fixes #24211.
- - - - -
dfe1c354 by Stefan Schulze Frielinghaus at 2023-11-28T22:45:04-05:00
llvmGen: Align objects in the data section
Objects in the data section may be referenced via tagged pointers.
Thus, align those objects to a 4- or 8-byte boundary for 32- or 64-bit
platforms, respectively. Note, this may need to be reconsidered if
objects with a greater natural alignment requirement are emitted as e.g.
128-bit atomics.
Fixes #24163.
- - - - -
f6c486c3 by Matthew Pickering at 2023-11-29T11:08:13-05:00
metrics: Widen libdir and size_hello_obj acceptance window
af8816740d9b8759be1a22af8adcb5f13edeb61d shows that the libdir size can
fluctuate quite significantly even when the change is quite small.
Therefore we widen the acceptance window to 10%.
- - - - -
99a6a49c by Alan Zimmerman at 2023-11-29T11:08:49-05:00
EPA: Clean up TC Monad Utils
We no longer need the alternative variant of addLocM (addLocMA)
nor wrapLocAM, wrapLocSndMA.
aarch64-darwin
Metric Increase:
MultiLayerModulesTH_OneShot
deb10-numa-slow
Metric Decrease:
libdir
- - - - -
cbc03fa0 by Sebastian Graf at 2023-11-30T12:37:21-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.
- - - - -
c7623b22 by Alan Zimmerman at 2023-11-30T12:37:56-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
- - - - -
bd8acc0c by Krzysztof Gogolewski at 2023-11-30T12:38:32-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
- - - - -
71cde983 by Hassan Al-Awwadi at 2023-12-03T11:36:16+01:00
Merge branch 'master' into wip/T24040-ghci-timeout
- - - - -
28 changed files:
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- distrib/configure.ac.in
- 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/perf/size/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/CmmToLlvm/Data.hs
=====================================
@@ -89,6 +89,7 @@ genLlvmData (sec, CmmStaticsRaw lbl xs) = do
align = case sec of
Section CString _ -> if (platformArch platform == ArchS390X)
then Just 2 else Just 1
+ Section Data _ -> Just $ platformWordSizeInBytes platform
_ -> Nothing
const = if sectionProtection sec == ReadOnlySection
then Constant else Global
=====================================
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/Rename/Bind.hs
=====================================
@@ -459,7 +459,7 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name })
rnBindLHS name_maker _ (PatSynBind x psb at PSB{ psb_id = rdrname })
| isTopRecNameMaker name_maker
- = do { addLocMA checkConName rdrname
+ = do { addLocM checkConName rdrname
; name <-
lookupLocatedTopConstructorRnN rdrname -- Should be in scope already
; return (PatSynBind x psb{ psb_ext = noAnn, psb_id = name }) }
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -276,7 +276,7 @@ rnSrcWarnDecls bndr_set decls'
; mapM_ (\ dups -> let ((L loc rdr) :| (lrdr':_)) = dups
in addErrAt (locA loc) (TcRnDuplicateWarningDecls lrdr' rdr))
warn_rdr_dups
- ; pairs_s <- mapM (addLocMA rn_deprec) decls
+ ; pairs_s <- mapM (addLocM rn_deprec) decls
; return $ concat pairs_s }
where
decls = concatMap (wd_warnings . unLoc) decls'
@@ -1891,7 +1891,7 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond
= do { unlessXOptM LangExt.TypeData $ failWith TcRnIllegalTypeData
; unless (null (fromMaybeContext context)) $
failWith $ TcRnTypeDataForbids TypeDataForbidsDatatypeContexts
- ; mapM_ (addLocMA check_type_data_condecl) condecls
+ ; mapM_ (addLocM check_type_data_condecl) condecls
; unless (null derivs) $
failWith $ TcRnTypeDataForbids TypeDataForbidsDerivingClauses
}
@@ -2384,7 +2384,7 @@ rnConDecl :: ConDecl GhcPs -> RnM (ConDecl GhcRn, FreeVars)
rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
, con_mb_cxt = mcxt, con_args = args
, con_doc = mb_doc, con_forall = forall_ })
- = do { _ <- addLocMA checkConName name
+ = do { _ <- addLocM checkConName name
; new_name <- lookupLocatedTopConstructorRnN name
-- We bind no implicit binders here; this is just like
@@ -2421,7 +2421,7 @@ rnConDecl (ConDeclGADT { con_names = names
, con_g_args = args
, con_res_ty = res_ty
, con_doc = mb_doc })
- = do { mapM_ (addLocMA checkConName) names
+ = do { mapM_ (addLocM checkConName) names
; new_names <- mapM (lookupLocatedTopConstructorRnN) names
; let -- We must ensure that we extract the free tkvs in left-to-right
=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -223,7 +223,7 @@ tcCompleteSigs sigs =
-- compatible with the result type constructor 'mb_tc'.
doOne (L loc c@(CompleteMatchSig (_ext, _src_txt) (L _ ns) mb_tc_nm))
= fmap Just $ setSrcSpanA loc $ addErrCtxt (text "In" <+> ppr c) $ do
- cls <- mkUniqDSet <$> mapM (addLocMA tcLookupConLike) ns
+ cls <- mkUniqDSet <$> mapM (addLocM tcLookupConLike) ns
mb_tc <- traverse @Maybe tcLookupLocatedTyCon mb_tc_nm
pure CompleteMatch { cmConLikes = cls, cmResultTyCon = mb_tc }
doOne _ = return Nothing
@@ -239,7 +239,7 @@ tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id]
tcHsBootSigs binds sigs
= do { unless (null binds) $
rejectBootDecls HsBoot BootBindsRn (concatMap (bagToList . snd) binds)
- ; concatMapM (addLocMA tc_boot_sig) (filter isTypeLSig sigs) }
+ ; concatMapM (addLocM tc_boot_sig) (filter isTypeLSig sigs) }
where
tc_boot_sig (TypeSig _ lnames hs_ty) = mapM f lnames
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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -1516,7 +1516,7 @@ inferInitialKinds decls
; traceTc "inferInitialKinds done }" empty
; return tcs }
where
- infer_initial_kind = addLocMA (getInitialKind InitialKindInfer)
+ infer_initial_kind = addLocM (getInitialKind InitialKindInfer)
-- Check type/class declarations against their standalone kind signatures or
-- CUSKs, producing a generalized TcTyCon for each.
@@ -1528,7 +1528,7 @@ checkInitialKinds decls
; return tcs }
where
check_initial_kind (ldecl, msig) =
- addLocMA (getInitialKind (InitialKindCheck msig)) ldecl
+ addLocM (getInitialKind (InitialKindCheck msig)) ldecl
-- | Get the initial kind of a TyClDecl, either generalized or non-generalized,
-- depending on the 'InitialKindStrategy'.
@@ -1556,7 +1556,7 @@ getInitialKind strategy
-- See Note [Don't process associated types in getInitialKind]
; at_tcs <- tcExtendTyVarEnv (tyConTyVars cls_tc) $
- mapM (addLocMA (getAssocFamInitialKind cls_tc)) ats
+ mapM (addLocM (getAssocFamInitialKind cls_tc)) ats
; return (cls_tc : at_tcs) }
where
getAssocFamInitialKind cls =
@@ -2621,7 +2621,7 @@ tcClassDecl1 roles_info class_name hs_ctxt meths fundeps sigs ats at_defs
-- The (binderVars tc_bndrs) is needed bring into scope the
-- skolems bound by the class decl header (#17841)
do { ctxt <- tcHsContext hs_ctxt
- ; fds <- mapM (addLocMA tc_fundep) fundeps
+ ; fds <- mapM (addLocM tc_fundep) fundeps
; sig_stuff <- tcClassSigs class_name sigs meths
; at_stuff <- tcClassATs class_name clas ats at_defs
; return (ctxt, fds, sig_stuff, at_stuff) }
@@ -2724,7 +2724,7 @@ tcClassATs class_name cls ats at_defs
(at_def_tycon at_def) [at_def])
emptyNameEnv at_defs
- tc_at at = do { (fam_tc, val_infos) <- addLocMA (tcFamDecl1 (Just cls)) at
+ tc_at at = do { (fam_tc, val_infos) <- addLocM (tcFamDecl1 (Just cls)) at
; mapM_ (checkTyFamEqnValidityInfo fam_tc) val_infos
; let at_defs = lookupNameEnv at_defs_map (at_fam_name at)
`orElse` []
@@ -3579,7 +3579,7 @@ tcConDecls :: DataDeclInfo
-> DataDefnCons (LConDecl GhcRn) -> TcM (DataDefnCons DataCon)
tcConDecls dd_info rep_tycon tmpl_bndrs res_kind
= concatMapDataDefnConsTcM (tyConName rep_tycon) $ \ new_or_data ->
- addLocMA $ tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind (mkTyConTagMap rep_tycon)
+ addLocM $ tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind (mkTyConTagMap rep_tycon)
-- mkTyConTagMap: it's important that we pay for tag allocation here,
-- once per TyCon. See Note [Constructor tag allocation], fixes #14657
=====================================
compiler/GHC/Tc/TyCl/Class.hs
=====================================
@@ -237,7 +237,7 @@ tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds GhcRn
tcDefMeth _ _ _ _ _ prag_fn (sel_id, Nothing)
= do { -- No default method
- mapM_ (addLocMA (badDmPrag sel_id ))
+ mapM_ (addLocM (badDmPrag sel_id ))
(lookupPragEnv prag_fn (idName sel_id))
; return emptyBag }
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -2425,7 +2425,7 @@ Note that
tcSpecInstPrags :: DFunId -> InstBindings GhcRn
-> TcM ([LTcSpecPrag], TcPragEnv)
tcSpecInstPrags dfun_id (InstBindings { ib_binds = binds, ib_pragmas = uprags })
- = do { spec_inst_prags <- mapM (wrapLocAM (tcSpecInst dfun_id)) $
+ = do { spec_inst_prags <- mapM (wrapLocM (tcSpecInst dfun_id)) $
filter isSpecInstLSig uprags
-- The filter removes the pragmas for methods
; return (spec_inst_prags, mkPragEnv uprags binds) }
=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -218,7 +218,7 @@ span of the Name.
tcLookupLocatedGlobal :: LocatedA Name -> TcM TyThing
-- c.f. GHC.IfaceToCore.tcIfaceGlobal
tcLookupLocatedGlobal name
- = addLocMA tcLookupGlobal name
+ = addLocM tcLookupGlobal name
tcLookupGlobal :: Name -> TcM TyThing
-- The Name is almost always an ExternalName, but not always
@@ -308,13 +308,13 @@ tcLookupAxiom name = do
_ -> wrongThingErr WrongThingAxiom (AGlobal thing) name
tcLookupLocatedGlobalId :: LocatedA Name -> TcM Id
-tcLookupLocatedGlobalId = addLocMA tcLookupId
+tcLookupLocatedGlobalId = addLocM tcLookupId
tcLookupLocatedClass :: LocatedA Name -> TcM Class
-tcLookupLocatedClass = addLocMA tcLookupClass
+tcLookupLocatedClass = addLocM tcLookupClass
tcLookupLocatedTyCon :: LocatedN Name -> TcM TyCon
-tcLookupLocatedTyCon = addLocMA tcLookupTyCon
+tcLookupLocatedTyCon = addLocM tcLookupTyCon
-- Find the instance that exactly matches a type class application. The class arguments must be precisely
-- the same as in the instance declaration (modulo renaming & casts).
@@ -440,7 +440,7 @@ tcExtendRecEnv gbl_stuff thing_inside
-}
tcLookupLocated :: LocatedA Name -> TcM TcTyThing
-tcLookupLocated = addLocMA tcLookup
+tcLookupLocated = addLocM tcLookup
tcLookupLcl_maybe :: Name -> TcM (Maybe TcTyThing)
tcLookupLcl_maybe name
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -61,9 +61,9 @@ module GHC.Tc.Utils.Monad(
addDependentFiles,
-- * Error management
- getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM, addLocMA,
+ getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
inGeneratedCode, setInGeneratedCode,
- wrapLocM, wrapLocAM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
+ wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
wrapLocMA_,wrapLocMA,
getErrsVar, setErrsVar,
addErr,
@@ -995,18 +995,15 @@ setInGeneratedCode thing_inside =
setSrcSpanA :: EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA l = setSrcSpan (locA l)
-addLocM :: (a -> TcM b) -> Located a -> TcM b
-addLocM fn (L loc a) = setSrcSpan loc $ fn a
+addLocM :: (HasLoc t) => (a -> TcM b) -> GenLocated t a -> TcM b
+addLocM fn (L loc a) = setSrcSpan (getHasLoc loc) $ fn a
-addLocMA :: (a -> TcM b) -> GenLocated (EpAnn ann) a -> TcM b
-addLocMA fn (L loc a) = setSrcSpanA loc $ fn a
-
-wrapLocM :: (a -> TcM b) -> Located a -> TcM (Located b)
-wrapLocM fn (L loc a) = setSrcSpan loc $ do { b <- fn a
- ; return (L loc b) }
-
-wrapLocAM :: (a -> TcM b) -> LocatedAn an a -> TcM (Located b)
-wrapLocAM fn a = wrapLocM fn (reLoc a)
+wrapLocM :: (HasLoc t) => (a -> TcM b) -> GenLocated t a -> TcM (Located b)
+wrapLocM fn (L loc a) =
+ let
+ loc' = getHasLoc loc
+ in setSrcSpan loc' $ do { b <- fn a
+ ; return (L loc' b) }
wrapLocMA :: (a -> TcM b) -> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA fn (L loc a) = setSrcSpanA loc $ do { b <- fn a
=====================================
distrib/configure.ac.in
=====================================
@@ -206,6 +206,18 @@ dnl Identify C++ standard library flavour and location
FP_FIND_CXX_STD_LIB
AC_CONFIG_FILES([mk/system-cxx-std-lib-1.0.conf])
+dnl ** Which otool to use on macOS
+dnl --------------------------------------------------------------
+AC_CHECK_TARGET_TOOL([OTOOL], [otool])
+OtoolCmd="$OTOOL"
+AC_SUBST(OtoolCmd)
+
+dnl ** Which install_name_tool to use on macOS
+dnl --------------------------------------------------------------
+AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool])
+InstallNameToolCmd="$INSTALL_NAME_TOOL"
+AC_SUBST(InstallNameToolCmd)
+
# Check that we have the same emsdk version as the one we were built with.
ConfiguredEmsdkVersion=@ConfiguredEmsdkVersion@
EMSDK_VERSION("", "", ${ConfiguredEmsdkVersion})
=====================================
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/perf/size/all.T
=====================================
@@ -1,3 +1,3 @@
-test('size_hello_obj', [collect_size(3, 'size_hello_obj.o')], compile, [''])
+test('size_hello_obj', [collect_size(5, 'size_hello_obj.o')], compile, [''])
-test('libdir',[stat_from_file('size', 3, 'SIZE')], makefile_test, ['libdir_size'] )
+test('libdir',[stat_from_file('size', 10, 'SIZE')], makefile_test, ['libdir_size'] )
=====================================
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/1082b52392938e42ec3a2e69f5d775dbebe92f01...71cde98358a14621727b0150fe5f7913d25578c1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1082b52392938e42ec3a2e69f5d775dbebe92f01...71cde98358a14621727b0150fe5f7913d25578c1
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/20231203/f94d5990/attachment-0001.html>
More information about the ghc-commits
mailing list