[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: nativeGen: Disable asm-shortcutting on Darwin

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Mon Jan 30 10:38:07 UTC 2023



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


Commits:
8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00
nativeGen: Disable asm-shortcutting on Darwin

Asm-shortcutting may produce relative references to symbols defined in
other compilation units. This is not something that MachO relocations
support (see #21972). For this reason we disable the optimisation on
Darwin. We do so without a warning since this flag is enabled by `-O2`.

Another way to address this issue would be to rather implement a
PLT-relocatable jump-table strategy. However, this would only benefit
Darwin and does not seem worth the effort.

Closes #21972.

- - - - -
da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00
compiler: fix data section alignment in the wasm NCG

Previously we tried to lower the alignment requirement as far as
possible, based on the section kind inferred from the CLabel. For info
tables, .p2align 1 was applied given the GC should only need the
lowest bit to tag forwarding pointers. But this would lead to
unaligned loads/stores, which has a performance penalty even if the
wasm spec permits it. Furthermore, the test suite has shown memory
corruption in a few cases when compacting gc is used.

This patch takes a more conservative approach: all data sections
except C strings align to word size.

- - - - -
c4af6b19 by Andreas Klebinger at 2023-01-30T05:37:49-05:00
ghc-the-library: Retain cafs in both static in dynamic builds.

We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a
__attribute__((constructor)) function.

This broke for static builds where the linker discarded the object file
since it was not reverenced from any exported code. We fix this by
asserting that the flag is enabled using a function in the same module
as the constructor. Which causes the object file to be retained by the
linker, which in turn causes the constructor the be run in static builds.

This changes nothing for dynamic builds using the ghc library. But causes
static to also retain CAFs (as we expect them to).

Fixes #22417.

-------------------------
Metric Decrease:
    T21839r
-------------------------

- - - - -
88c30ea8 by Ryan Scott at 2023-01-30T05:37:49-05:00
Fix two bugs in TypeData TH reification

This patch fixes two issues in the way that `type data` declarations were
reified with Template Haskell:

* `type data` data constructors are now properly reified using `DataConI`.
  This is accomplished with a special case in `reifyTyCon`. Fixes #22818.

* `type data` type constructors are now reified in `reifyTyCon` using
  `TypeDataD` instead of `DataD`. Fixes #22819.

- - - - -
877ca814 by Matthew Pickering at 2023-01-30T05:37:50-05:00
ci: Remove FreeBSD job from release pipelines

We no longer attempt to build or distribute this release

- - - - -
f4c61d18 by Matthew Pickering at 2023-01-30T05:37:50-05:00
rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab

This check makes sure that if a job is a prefixed by "release-" then the
script downloads it and understands how to map the job name to the
platform.

- - - - -
7e9e452e by Matthew Pickering at 2023-01-30T05:37:50-05:00
rel_eng: Fix the name of the ubuntu-* jobs

These were not uploaded for alpha1

Fixes #22844

- - - - -
bdd3ed5b by Matthew Pickering at 2023-01-30T05:37:50-05:00
gen_ci: Only consider release jobs for job metadata

In particular we do not have a release job for FreeBSD so the generation
of the platform mapping was failing.

- - - - -
0c3428ff by Jason Shipman at 2023-01-30T05:37:51-05:00
User's guide: Clarify overlapping instance candidate elimination

This commit updates the user's guide section on overlapping instance candidate
elimination to use "or" verbiage instead of "either/or" in regards to the
current pair of candidates' being overlappable or overlapping. "Either IX is
overlappable, or IY is overlapping" can cause confusion as it suggests "Either
IX is overlappable, or IY is overlapping, but not both".

This was initially discussed on this Discourse topic:

https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677

- - - - -
b0263a1d by Simon Peyton Jones at 2023-01-30T05:37:52-05:00
Treat existentials correctly in dubiousDataConInstArgTys

Consider (#22849)

 data T a where
   MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a

Then dubiousDataConInstArgTys MkT [Type, Foo] should return
        [Foo (ix::Type)]
NOT     [Foo (ix::k)]

A bit of an obscure case, but it's an outright bug, and the fix is easy.

- - - - -


20 changed files:

- .gitlab-ci.yml
- .gitlab/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- compiler/GHC.hs
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/cbits/keepCAFsForGHCi.c
- docs/users_guide/exts/instances.rst
- docs/users_guide/using-optimisation.rst
- testsuite/tests/ghci/T16392/T16392.script
- + testsuite/tests/simplCore/should_compile/T22849.hs
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/th/T22818.hs
- + testsuite/tests/th/T22818.stderr
- + testsuite/tests/th/T22819.hs
- + testsuite/tests/th/T22819.stderr
- testsuite/tests/th/all.T


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -277,6 +277,8 @@ lint-ci-config:
     - .gitlab/generate_jobs
     # 1 if .gitlab/generate_jobs changed the output of the generated config
     - nix shell nixpkgs#git -c git diff --exit-code
+    # And run this to just make sure that works
+    - .gitlab/generate_job_metadata
   dependencies: []
 
 lint-submods:


=====================================
.gitlab/gen_ci.hs
=====================================
@@ -17,7 +17,6 @@ import Data.List (intercalate)
 import Data.Set (Set)
 import qualified Data.Set as S
 import System.Environment
-import Data.Maybe
 
 {-
 Note [Generating the CI pipeline]
@@ -875,7 +874,7 @@ job_groups =
      , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla))
      , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt))
      , standardBuilds Amd64 Darwin
-     , allowFailureGroup (addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD13))
+     , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla))
      , standardBuilds AArch64 Darwin
      , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)
      , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm)
@@ -932,7 +931,7 @@ mkPlatform arch opsys = archName arch <> "-" <> opsysName opsys
 --  * Explicitly require tie-breaking for other cases.
 platform_mapping :: Map String (JobGroup BindistInfo)
 platform_mapping = Map.map go $
-  Map.fromListWith combine [ (uncurry mkPlatform (jobPlatform (jobInfo $ v j)), j) | j <- job_groups ]
+  Map.fromListWith combine [ (uncurry mkPlatform (jobPlatform (jobInfo $ v j)), j) | j <- filter hasReleaseBuild job_groups ]
   where
     whitelist = [ "x86_64-linux-alpine3_12-int_native-validate+fully_static"
                 , "x86_64-linux-deb10-validate"
@@ -943,8 +942,6 @@ platform_mapping = Map.map go $
     combine a b
       | name (v a) `elem` whitelist = a -- Explicitly selected
       | name (v b) `elem` whitelist = b
-      | hasReleaseBuild a, not (hasReleaseBuild b) = a -- Has release build, but other doesn't
-      | hasReleaseBuild b, not (hasReleaseBuild a) = b
       | otherwise = error (show (name (v a)) ++ show (name (v b)))
 
     go = fmap (BindistInfo . unwords . fromJust . mmlookup "BIN_DIST_NAME" . jobVariables)


=====================================
.gitlab/jobs.yaml
=====================================
@@ -2358,68 +2358,6 @@
       "ac_cv_func_utimensat": "no"
     }
   },
-  "release-x86_64-freebsd13-release": {
-    "after_script": [
-      ".gitlab/ci.sh save_cache",
-      ".gitlab/ci.sh clean",
-      "cat ci_timings"
-    ],
-    "allow_failure": true,
-    "artifacts": {
-      "expire_in": "1 year",
-      "paths": [
-        "ghc-x86_64-freebsd13-release.tar.xz",
-        "junit.xml"
-      ],
-      "reports": {
-        "junit": "junit.xml"
-      },
-      "when": "always"
-    },
-    "cache": {
-      "key": "x86_64-freebsd13-$CACHE_REV",
-      "paths": [
-        "cabal-cache",
-        "toolchain"
-      ]
-    },
-    "dependencies": [],
-    "image": null,
-    "needs": [
-      {
-        "artifacts": false,
-        "job": "hadrian-ghc-in-ghci"
-      }
-    ],
-    "rules": [
-      {
-        "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")",
-        "when": "on_success"
-      }
-    ],
-    "script": [
-      ".gitlab/ci.sh setup",
-      ".gitlab/ci.sh configure",
-      ".gitlab/ci.sh build_hadrian",
-      ".gitlab/ci.sh test_hadrian"
-    ],
-    "stage": "full-build",
-    "tags": [
-      "x86_64-freebsd13"
-    ],
-    "variables": {
-      "BIGNUM_BACKEND": "gmp",
-      "BIN_DIST_NAME": "ghc-x86_64-freebsd13-release",
-      "BUILD_FLAVOUR": "release",
-      "CABAL_INSTALL_VERSION": "3.8.1.0",
-      "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ",
-      "GHC_VERSION": "9.4.3",
-      "HADRIAN_ARGS": "--docs=no-sphinx",
-      "IGNORE_PERF_FAILURES": "all",
-      "TEST_ENV": "x86_64-freebsd13-release",
-      "XZ_OPT": "-9"
-    }
-  },
   "release-x86_64-linux-alpine3_12-int_native-release+fully_static": {
     "after_script": [
       ".gitlab/ci.sh save_cache",


=====================================
.gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
=====================================
@@ -12,13 +12,15 @@ def strip_prefix(s, prefix):
     else:
         return None
 
+do_not_distribute = set(["release-x86_64-linux-fedora33-release-hackage"])
+
 def job_triple(job_name):
     bindists = {
         'release-x86_64-windows-release': 'x86_64-unknown-mingw32',
         'release-x86_64-windows-int_native-release': 'x86_64-unknown-mingw32-int_native',
         'release-x86_64-rocky8-release': 'x86_64-rocky8-linux',
-        'release-x86_64-ubuntu20_04-release': 'x86_64-ubuntu20_04-linux',
-        'release-x86_64-ubuntu18_04-release': 'x86_64-ubuntu18_04-linux',
+        'release-x86_64-linux-ubuntu20_04-release': 'x86_64-ubuntu20_04-linux',
+        'release-x86_64-linux-ubuntu18_04-release': 'x86_64-ubuntu18_04-linux',
         'release-x86_64-linux-fedora33-release+debug_info': 'x86_64-fedora33-linux-dwarf',
         'release-x86_64-linux-fedora33-release': 'x86_64-fedora33-linux',
         'release-x86_64-linux-fedora27-release': 'x86_64-fedora27-linux',
@@ -54,6 +56,12 @@ def job_triple(job_name):
         #return strip_prefix(job.name, 'validate-')
         return None
 
+class UnhandledJobException(Exception):
+    # Raised when there is a release job in the pipeline but we don't explicitly handle it.
+    def __init__(self, name):
+        self.message = f"{name} is a release job but not downloaded"
+        super().__init__(self.message)
+
 def fetch_artifacts(release: str, pipeline_id: int,
                     dest_dir: Path, gl: gitlab.Gitlab):
     dest_dir.mkdir(exist_ok=True)
@@ -72,6 +80,8 @@ def fetch_artifacts(release: str, pipeline_id: int,
         job = proj.jobs.get(pipeline_job.id)
         triple = job_triple(job.name)
         if triple is None:
+            if job.name.startswith("release") and not (job.name in do_not_distribute):
+                raise(UnhandledJobException(job.name))
             logging.info(f'ignoring {job.name}')
             continue
 


=====================================
compiler/GHC.hs
=====================================
@@ -3,6 +3,7 @@
 {-# LANGUAGE TupleSections, NamedFieldPuns #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -ddump-stg-final -ddump-to-file #-}
 
 -- -----------------------------------------------------------------------------
 --
@@ -357,6 +358,7 @@ import GHC.Utils.Monad
 import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain
 import GHC.Utils.Logger
 import GHC.Utils.Fingerprint
 
@@ -556,7 +558,16 @@ withCleanupSession ghc = ghc `MC.finally` cleanup
 -- <http://hackage.haskell.org/package/ghc-paths>.
 
 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
-initGhcMonad mb_top_dir = setSession =<< liftIO (initHscEnv mb_top_dir)
+initGhcMonad mb_top_dir = setSession =<< liftIO ( do
+    -- The call to c_keepCAFsForGHCi must not be optimized away. Even in non-debug builds.
+    -- So we can't use assertM here.
+    -- See Note [keepCAFsForGHCi] in keepCAFsForGHCi.c for details about why.
+-- #if MIN_VERSION_GLASGOW_HASKELL(9,7,0,0)
+    !keep_cafs <- c_keepCAFsForGHCi
+    massert keep_cafs
+-- #endif
+    initHscEnv mb_top_dir
+  )
 
 -- %************************************************************************
 -- %*                                                                      *
@@ -1948,3 +1959,8 @@ instance Exception GhcApiError
 
 mkApiErr :: DynFlags -> SDoc -> GhcApiError
 mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
+
+--
+foreign import ccall unsafe "keepCAFsForGHCi"
+    c_keepCAFsForGHCi   :: IO Bool
+


=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -812,6 +812,19 @@ generateJumpTables ncgImpl xs = concatMap f xs
 -- -----------------------------------------------------------------------------
 -- Shortcut branches
 
+-- Note [No asm-shortcutting on Darwin]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Asm-shortcutting may produce relative references to symbols defined in
+-- other compilation units. This is not something that MachO relocations
+-- support (see #21972). For this reason we disable the optimisation on Darwin.
+-- We do so in the backend without a warning since this flag is enabled by
+-- `-O2`.
+--
+-- Another way to address this issue would be to rather implement a
+-- PLT-relocatable jump-table strategy. However, this would only benefit Darwin
+-- and does not seem worth the effort as this optimisation generally doesn't
+-- offer terribly great benefits.
+
 shortcutBranches
         :: forall statics instr jumpDest. (Outputable jumpDest)
         => NCGConfig
@@ -822,6 +835,8 @@ shortcutBranches
 
 shortcutBranches config ncgImpl tops weights
   | ncgEnableShortcutting config
+    -- See Note [No asm-shortcutting on Darwin]
+  , not $ osMachOTarget $ platformOS $ ncgPlatform config
   = ( map (apply_mapping ncgImpl mapping) tops'
     , shortcutWeightMap mappingBid <$!> weights )
   | otherwise


=====================================
compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
=====================================
@@ -123,15 +123,15 @@ alignmentFromWordType TagI32 = mkAlignment 4
 alignmentFromWordType TagI64 = mkAlignment 8
 alignmentFromWordType _ = panic "alignmentFromWordType: unreachable"
 
--- | Calculate a data section's alignment. Closures needs to be
--- naturally aligned; info tables need to align to 2, so to get 1 tag
--- bit as forwarding pointer marker. The rest have no alignment
--- requirements.
-alignmentFromCmmSection :: WasmTypeTag w -> CLabel -> Alignment
-alignmentFromCmmSection t lbl
-  | isStaticClosureLabel lbl = alignmentFromWordType t
-  | isInfoTableLabel lbl = mkAlignment 2
-  | otherwise = mkAlignment 1
+-- | Calculate a data section's alignment. As a conservative
+-- optimization, a data section with a single CmmString/CmmFileEmbed
+-- has no alignment requirement, otherwise we always align to the word
+-- size to satisfy pointer tagging requirements and avoid unaligned
+-- loads/stores.
+alignmentFromCmmSection :: WasmTypeTag w -> [DataSectionContent] -> Alignment
+alignmentFromCmmSection _ [DataASCII {}] = mkAlignment 1
+alignmentFromCmmSection _ [DataIncBin {}] = mkAlignment 1
+alignmentFromCmmSection t _ = alignmentFromWordType t
 
 -- | Lower a 'CmmStatic'.
 lower_CmmStatic :: CmmStatic -> WasmCodeGenM w DataSectionContent
@@ -1650,7 +1650,7 @@ onCmmData lbl s statics = do
           { dataSectionKind =
               dataSectionKindFromCmmSection s,
             dataSectionAlignment =
-              alignmentFromCmmSection ty_word lbl,
+              alignmentFromCmmSection ty_word cs,
             dataSectionContents =
               case cs of
                 [DataASCII buf] -> [DataASCII $ buf `BS.snoc` 0]


=====================================
compiler/GHC/Core/Opt/WorkWrap/Utils.hs
=====================================
@@ -707,7 +707,7 @@ Worker/wrapper will unbox
        * is an algebraic data type (not a newtype)
        * is not recursive (as per 'isRecDataCon')
        * has a single constructor (thus is a "product")
-       * that may bind existentials
+       * that may bind existentials (#18982)
      We can transform
      > data D a = forall b. D a b
      > f (D @ex a b) = e
@@ -1272,16 +1272,25 @@ also unbox its components. That is governed by the `usefulSplit` mechanism.
 -}
 
 -- | Exactly 'dataConInstArgTys', but lacks the (ASSERT'ed) precondition that
--- the 'DataCon' may not have existentials. The lack of cloning the existentials
--- compared to 'dataConInstExAndArgVars' makes this function \"dubious\";
--- only use it where type variables aren't substituted for!
+-- the 'DataCon' may not have existentials. The lack of cloning the
+-- existentials this function \"dubious\"; only use it where type variables
+-- aren't substituted for!  Why may the data con bind existentials?
+--    See Note [Which types are unboxed?]
 dubiousDataConInstArgTys :: DataCon -> [Type] -> [Type]
 dubiousDataConInstArgTys dc tc_args = arg_tys
   where
-    univ_tvs = dataConUnivTyVars dc
-    ex_tvs   = dataConExTyCoVars dc
-    subst    = extendSubstInScopeList (zipTvSubst univ_tvs tc_args) ex_tvs
-    arg_tys  = map (GHC.Core.Type.substTy subst . scaledThing) (dataConRepArgTys dc)
+    univ_tvs        = dataConUnivTyVars dc
+    ex_tvs          = dataConExTyCoVars dc
+    univ_subst      = zipTvSubst univ_tvs tc_args
+    (full_subst, _) = substTyVarBndrs univ_subst ex_tvs
+    arg_tys         = map (substTy full_subst . scaledThing) $
+                      dataConRepArgTys dc
+    -- NB: use substTyVarBndrs on ex_tvs to ensure that we
+    --     substitute in their kinds.  For example (#22849)
+    -- Consider data T a where
+    --            MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a
+    -- Then dubiousDataConInstArgTys MkT [Type, Foo] should return
+    --        [Foo (ix::Type)], not [Foo (ix::k)]!
 
 findTypeShape :: FamInstEnvs -> Type -> TypeShape
 -- Uncover the arrow and product shape of a type


=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -2065,11 +2065,7 @@ reifyThing (AGlobal (AnId id))
 
 reifyThing (AGlobal (ATyCon tc))   = reifyTyCon tc
 reifyThing (AGlobal (AConLike (RealDataCon dc)))
-  = do  { let name = dataConName dc
-        ; ty <- reifyType (idType (dataConWrapId dc))
-        ; return (TH.DataConI (reifyName name) ty
-                              (reifyName (dataConOrigTyCon dc)))
-        }
+  = mkDataConI dc
 
 reifyThing (AGlobal (AConLike (PatSynCon ps)))
   = do { let name = reifyName ps
@@ -2173,6 +2169,13 @@ reifyTyCon tc
                    (TH.TySynD (reifyName tc) tvs' rhs'))
        }
 
+  -- Special case for `type data` data constructors, which are reified as
+  -- `ATyCon`s rather than `ADataCon`s (#22818).
+  -- See Note [Type data declarations] in GHC.Rename.Module.
+  | Just dc <- isPromotedDataCon_maybe tc
+  , isTypeDataCon dc
+  = mkDataConI dc
+
   | otherwise
   = do  { cxt <- reifyCxt (tyConStupidTheta tc)
         ; let tvs      = tyConTyVars tc
@@ -2182,7 +2185,12 @@ reifyTyCon tc
         ; r_tvs <- reifyTyVars (tyConVisibleTyVars tc)
         ; let name = reifyName tc
               deriv = []        -- Don't know about deriving
-              decl | isNewTyCon tc =
+              decl | isTypeDataTyCon tc =
+                       -- `type data` declarations have a special `Dec`,
+                       -- separate from other `DataD`s. See
+                       -- [Type data declarations] in GHC.Rename.Module.
+                       TH.TypeDataD name r_tvs Nothing cons
+                   | isNewTyCon tc =
                        TH.NewtypeD cxt name r_tvs Nothing (head cons) deriv
                    | otherwise     =
                        TH.DataD    cxt name r_tvs Nothing       cons  deriv
@@ -2261,6 +2269,14 @@ reifyDataCon isGadtDataCon tys dc
           tv_bndrs'      = map (\(tv,fl) -> Bndr tv fl) (zip tvs' flags)
       in (subst', tv_bndrs')
 
+mkDataConI :: DataCon -> TcM TH.Info
+mkDataConI dc
+  = do  { let name = dataConName dc
+        ; ty <- reifyType (idType (dataConWrapId dc))
+        ; return (TH.DataConI (reifyName name) ty
+                              (reifyName (dataConOrigTyCon dc)))
+        }
+
 {-
 Note [Freshen reified GADT constructors' universal tyvars]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


=====================================
compiler/cbits/keepCAFsForGHCi.c
=====================================
@@ -1,15 +1,35 @@
 #include <Rts.h>
+#include <ghcversion.h>
 
+// Note [keepCAFsForGHCi]
+// ~~~~~~~~~~~~~~~~~~~~~~
 // This file is only included in the dynamic library.
 // It contains an __attribute__((constructor)) function (run prior to main())
 // which sets the keepCAFs flag in the RTS, before any Haskell code is run.
 // This is required so that GHCi can use dynamic libraries instead of HSxyz.o
 // files.
+//
+// For static builds we have to guarantee that the linker loads this object file
+// to ensure the constructor gets run and not discarded. If the object is part of
+// an archive and not otherwise referenced the linker would ignore the object.
+// To avoid this:
+// * When initializing a GHC session in initGhcMonad we assert keeping cafs has been
+//   enabled by calling keepCAFsForGHCi.
+// * This causes the GHC module from the ghc package to carry a reference to this object
+//   file.
+// * Which in turn ensures the linker doesn't discard this object file, causing
+//   the constructor to be run, allowing the assertion to succeed in the first place
+//   as keepCAFs will have been set already during initialization of constructors.
 
-static void keepCAFsForGHCi(void) __attribute__((constructor));
 
-static void keepCAFsForGHCi(void)
+
+bool keepCAFsForGHCi(void) __attribute__((constructor));
+
+bool keepCAFsForGHCi(void)
 {
-    keepCAFs = 1;
+    bool was_set = keepCAFs;
+    setKeepCAFs();
+    return was_set;
 }
 
+


=====================================
docs/users_guide/exts/instances.rst
=====================================
@@ -486,8 +486,8 @@ like this:
    -  :math:`IY` is strictly more specific than :math:`IX`.  That
       is, :math:`IY` is a substitution instance of :math:`IX` but not vice versa.
 
-   -  Either :math:`IX` is *overlappable*, or :math:`IY` is *overlapping*. (This
-      "either/or" design, rather than a "both/and" design, allow a
+   -  :math:`IX` is *overlappable* or :math:`IY` is *overlapping*. (This
+      "or" design, rather than an "and" design, allows a
       client to deliberately override an instance from a library,
       without requiring a change to the library.)
 


=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -262,8 +262,10 @@ by saying ``-fno-wombat``.
     of a unconditionally jump, we replace all jumps to A by jumps to the successor
     of A.
 
-    This is mostly done during Cmm passes. However this can miss corner cases. So at -O2
-    we run the pass again at the asm stage to catch these.
+    This is mostly done during Cmm passes. However this can miss corner cases.
+    So at ``-O2`` this flag runs the pass again at the assembly stage to catch
+    these. Note that due to platform limitations (:ghc-ticket:`21972`) this flag
+    does nothing on macOS.
 
 .. ghc-flag:: -fblock-layout-cfg
     :shortdesc: Use the new cfg based block layout algorithm.


=====================================
testsuite/tests/ghci/T16392/T16392.script
=====================================
@@ -1,5 +1,7 @@
 :set -fobject-code
+import System.Mem
 :load A.hs
 c_two caf
+performMajorGC
 :load A.hs
 c_two caf


=====================================
testsuite/tests/simplCore/should_compile/T22849.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE GADTs #-}
+
+module T22849 where
+
+data Foo a where
+  Foo :: Foo Int
+
+data Bar a = Bar a (Foo a)
+
+data Some t = forall ix. Some (t ix)
+
+instance Show (Some Bar) where
+  show (Some (Bar v t)) = case t of
+    Foo -> show v


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -470,3 +470,4 @@ test('T22725', normal, compile, ['-O'])
 test('T22502', normal, compile, ['-O'])
 test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all'])
 test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively'])
+test('T22849', normal, compile, ['-O'])


=====================================
testsuite/tests/th/T22818.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeData #-}
+module T22818 where
+
+import Language.Haskell.TH
+import System.IO
+
+type data T = MkT
+
+$(pure [])
+
+$(do i <- reify ''MkT
+     runIO $ do
+       hPutStrLn stderr $ pprint i
+       hFlush stderr
+     pure [])


=====================================
testsuite/tests/th/T22818.stderr
=====================================
@@ -0,0 +1 @@
+Constructor from T22818.T: T22818.MkT :: T22818.T


=====================================
testsuite/tests/th/T22819.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeData #-}
+module T22818 where
+
+import Language.Haskell.TH
+import System.IO
+
+type data T = MkT
+
+$(pure [])
+
+$(do i <- reify ''T
+     runIO $ do
+       hPutStrLn stderr $ pprint i
+       hFlush stderr
+     pure [])


=====================================
testsuite/tests/th/T22819.stderr
=====================================
@@ -0,0 +1 @@
+type data T22818.T = T22818.MkT


=====================================
testsuite/tests/th/all.T
=====================================
@@ -556,4 +556,6 @@ test('T21920', normal, compile_and_run, [''])
 test('T21723', normal, compile_and_run, [''])
 test('T21942', normal, compile_and_run, [''])
 test('T22784', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T22818', normal, compile, ['-v0'])
+test('T22819', normal, compile, ['-v0'])
 test('TH_fun_par', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed9a457ed92ca12a805526100581fa23b9c05b2b...b0263a1df3aabdc5836911d4a1984b1bf2e5f7ea

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed9a457ed92ca12a805526100581fa23b9c05b2b...b0263a1df3aabdc5836911d4a1984b1bf2e5f7ea
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/20230130/f7481a01/attachment-0001.html>


More information about the ghc-commits mailing list