[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: testsuite: Rename isCross() predicate to needsTargetWrapper()

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Apr 18 23:45:09 UTC 2024



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


Commits:
ea0d50ab by Matthew Pickering at 2024-04-18T19:44:37-04:00
testsuite: Rename isCross() predicate to needsTargetWrapper()

isCross() was a misnamed because it assumed that all cross targets would
provide a target wrapper, but the two most common cross targets
(javascript, wasm) don't need a target wrapper.

Therefore we rename this predicate to `needsTargetWrapper()` so
situations in the testsuite where we can check whether running
executables requires a target wrapper or not.

- - - - -
e87772da by Simon Peyton Jones at 2024-04-18T19:44:38-04:00
Do not float HNFs out of lambdas

This MR adjusts SetLevels so that it is less eager to float a
HNF (lambda or constructor application) out of a lambda, unless
it gets to top level.

Data suggests that this change is a small net win:
 * nofib bytes-allocated falls by -0.09% (but a couple go up)
 * perf/should_compile bytes-allocated falls by -0.5%
 * perf/should_run bytes-allocated falls by -0.1%
See !12410 for more detail.

When fiddling elsewhere, I also found that this patch had a huge
positive effect on the (very delicate) test
  perf/should_run/T21839r
But that improvement doesn't show up in this MR by itself.

Metric Decrease:
    MultiLayerModulesRecomp
    T15703
    parsing001

- - - - -
e344def5 by Alan Zimmerman at 2024-04-18T19:44:38-04:00
EPA: Fix comments in mkListSyntaxTy0

Also extend the test to confirm.

Addresses #24669, 1 of 4

- - - - -
00c14e8a by Serge S. Gulin at 2024-04-18T19:44:44-04:00
JS: set image `x86_64-linux-deb11-emsdk-closure` for build

- - - - -
2e42e6e0 by Alan Zimmerman at 2024-04-18T19:44:44-04:00
EPA: Provide correct span for PatBind

And remove unused parameter in checkPatBind

Contributes to #24669

- - - - -


16 changed files:

- .gitlab-ci.yml
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/ThToHs.hs
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/linear/should_fail/LinearLet6.stderr
- testsuite/tests/linear/should_fail/LinearLet7.stderr
- testsuite/tests/printer/AnnotationNoListTuplePuns.hs
- + testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
- testsuite/tests/simplCore/should_compile/T18013.stderr
- testsuite/tests/simplCore/should_run/simplrun009.hs


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
   GIT_SSL_NO_VERIFY: "1"
 
   # Commit of ghc/ci-images repository from which to pull Docker images
-  DOCKER_REV: a9297a370025101b479cfd4977f8f910814e03ab
+  DOCKER_REV: 064e90c26dffe5709bd5b87dbd211b9a8b21fc5b
 
   # Sequential version number of all cached things.
   # Bump to invalidate GitLab CI cache.


=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -107,6 +107,7 @@ data Opsys
 data LinuxDistro
   = Debian12
   | Debian11
+  | Debian11Js
   | Debian10
   | Debian9
   | Fedora33
@@ -285,12 +286,13 @@ tags arch opsys _bc = [runnerTag arch opsys] -- Tag for which runners we can use
 -- These names are used to find the docker image so they have to match what is
 -- in the docker registry.
 distroName :: LinuxDistro -> String
-distroName Debian12  = "deb12"
-distroName Debian11  = "deb11"
+distroName Debian12   = "deb12"
+distroName Debian11   = "deb11"
+distroName Debian11Js = "deb11-emsdk-closure"
 distroName Debian10   = "deb10"
-distroName Debian9   = "deb9"
-distroName Fedora33  = "fedora33"
-distroName Fedora38  = "fedora38"
+distroName Debian9    = "deb9"
+distroName Fedora33   = "fedora33"
+distroName Fedora38   = "fedora38"
 distroName Ubuntu1804 = "ubuntu18_04"
 distroName Ubuntu2004 = "ubuntu20_04"
 distroName Centos7    = "centos7"
@@ -1009,7 +1011,7 @@ job_groups =
      , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine312) staticNativeInt)))
      , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing)
 
-     , addValidateRule JSBackend (validateBuilds Amd64 (Linux Debian11) javascriptConfig)
+     , addValidateRule JSBackend (validateBuilds Amd64 (Linux Debian11Js) javascriptConfig)
 
      , make_wasm_jobs wasm_build_config
      , modifyValidateJobs manual $


=====================================
.gitlab/jobs.yaml
=====================================
@@ -1706,7 +1706,7 @@
       "XZ_OPT": "-9"
     }
   },
-  "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": {
+  "nightly-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -1717,7 +1717,7 @@
     "artifacts": {
       "expire_in": "8 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz",
+        "ghc-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -1727,14 +1727,14 @@
       "when": "always"
     },
     "cache": {
-      "key": "x86_64-linux-deb11-$CACHE_REV",
+      "key": "x86_64-linux-deb11-emsdk-closure-$CACHE_REV",
       "paths": [
         "cabal-cache",
         "toolchain"
       ]
     },
     "dependencies": [],
-    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
+    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11-emsdk-closure:$DOCKER_REV",
     "needs": [
       {
         "artifacts": false,
@@ -1760,14 +1760,14 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "native",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate",
       "BUILD_FLAVOUR": "validate",
       "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
       "CONFIGURE_WRAPPER": "emconfigure",
       "CROSS_EMULATOR": "js-emulator",
       "CROSS_TARGET": "javascript-unknown-ghcjs",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate",
+      "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate",
       "XZ_OPT": "-9"
     }
   },
@@ -5087,7 +5087,7 @@
       "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate"
     }
   },
-  "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": {
+  "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate": {
     "after_script": [
       ".gitlab/ci.sh save_cache",
       ".gitlab/ci.sh save_test_output",
@@ -5098,7 +5098,7 @@
     "artifacts": {
       "expire_in": "2 weeks",
       "paths": [
-        "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz",
+        "ghc-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz",
         "junit.xml",
         "unexpected-test-output.tar.gz"
       ],
@@ -5108,14 +5108,14 @@
       "when": "always"
     },
     "cache": {
-      "key": "x86_64-linux-deb11-$CACHE_REV",
+      "key": "x86_64-linux-deb11-emsdk-closure-$CACHE_REV",
       "paths": [
         "cabal-cache",
         "toolchain"
       ]
     },
     "dependencies": [],
-    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
+    "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11-emsdk-closure:$DOCKER_REV",
     "needs": [
       {
         "artifacts": false,
@@ -5141,14 +5141,14 @@
     ],
     "variables": {
       "BIGNUM_BACKEND": "native",
-      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate",
+      "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate",
       "BUILD_FLAVOUR": "validate",
       "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check",
       "CONFIGURE_WRAPPER": "emconfigure",
       "CROSS_EMULATOR": "js-emulator",
       "CROSS_TARGET": "javascript-unknown-ghcjs",
       "RUNTEST_ARGS": "",
-      "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate"
+      "TEST_ENV": "x86_64-linux-deb11-emsdk-closure-int_native-cross_javascript-unknown-ghcjs-validate"
     }
   },
   "x86_64-linux-deb11-validate+boot_nonmoving_gc": {


=====================================
compiler/GHC/Core/Opt/SetLevels.hs
=====================================
@@ -700,15 +700,13 @@ lvlMFE env strict_ctxt ann_expr
         -- that if we'll escape a value lambda, or will go to the top level.
     float_me = saves_work || saves_alloc || is_mk_static
 
-    -- We can save work if we can move a redex outside a value lambda
-    -- But if float_is_new_lam is True, then the redex is wrapped in a
-    -- a new lambda, so no work is saved
-    saves_work = escapes_value_lam && not float_is_new_lam
-
+    -- See Note [Saving work]
+    saves_work = escapes_value_lam        -- (a)
+                 && not (exprIsHNF expr)  -- (b)
+                 && not float_is_new_lam  -- (c)
     escapes_value_lam = dest_lvl `ltMajLvl` (le_ctxt_lvl env)
-                  -- See Note [Escaping a value lambda]
 
-    -- See Note [Floating to the top]
+    -- See Note [Saving allocation] and Note [Floating to the top]
     saves_alloc =  isTopLvl dest_lvl
                 && floatConsts env
                 && (   not strict_ctxt                     -- (a)
@@ -723,30 +721,105 @@ hasFreeJoin :: LevelEnv -> DVarSet -> Bool
 hasFreeJoin env fvs
   = not (maxFvLevel isJoinId env fvs == tOP_LEVEL)
 
-{- Note [Floating to the top]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Suppose saves_work is False, i.e.
- - 'e' does not escape a value lambda (escapes_value_lam), or
- - 'e' would have added value lambdas if floated (float_is_new_lam)
-Then we may still be keen to float a sub-expression 'e' to the top level,
-for two reasons:
-
- (i) Doing so makes the function smaller, by floating out
-     bottoming expressions, or integer or string literals.  That in
-     turn makes it easier to inline, with less duplication.
-     This only matters if the floated sub-expression is inside a
-     value-lambda, which in turn may be easier to inline.
-
- (ii) (Minor) Doing so may turn a dynamic allocation (done by machine
-      instructions) into a static one. Minor because we are assuming
-      we are not escaping a value lambda.
-
-But only do so if (saves_alloc):
-     (a) the context is lazy (so we get allocation), or
-     (b) the expression is a HNF (so we get allocation), or
-     (c) the expression is bottoming and (i) applies
-         (NB: if the expression is a lambda, (b) will apply;
-              so this case only catches bottoming thunks)
+{- Note [Saving work]
+~~~~~~~~~~~~~~~~~~~~~
+The key idea in let-floating is to
+  * float a redex out of a (value) lambda
+Doing so can save an unbounded amount of work.
+But see also Note [Saving allocation].
+
+So we definitely float an expression out if
+(a) It will escape a value lambda (escapes_value_lam)
+(b) The expression is not a head-normal form (exprIsHNF); see (SW1, SW2).
+(c) Floating does not require wrapping it in value lambdas (float_is_new_lam).
+    See (SW3) below
+
+Wrinkles:
+
+(SW1) Concerning (b) I experimented with using `exprIsCheap` rather than
+      `exprIsHNF` but the latter seems better, according to nofib
+      (`spectral/mate` got 10% worse with exprIsCheap).  It's really a bit of a
+      heuristic.
+
+(SW2) What about omitting (b), and hence floating HNFs as well?  The danger of
+      doing so is that we end up floating out a HNF from a cold path (where it
+      might never get allocated at all) and allocating it all the time
+      regardless.  Example
+          f xs = case xs of
+                   [x] | x>3       -> (y,y)
+                       | otherwise -> (x,y)
+                   (x:xs) -> ...f xs...
+      We can float (y,y) out, but in a particular call to `f` that path might
+      not be taken, so allocating it before the definition of `f` is a waste.
+
+      See !12410 for some data comparing the effect of omitting (b) altogether,
+      This doesn't apply, though, if we float the thing to the top level; see
+      Note [Floating to the top].  Bottom line (data from !12410): adding the
+      not.exprIsHNF test to `saves_work`:
+       - Decreases compiler allocations by 0.5%
+       - Occasionally decreases runtime allocation (T12996 -2.5%)
+       - Slightly mixed effect on nofib: (puzzle -10%, mate -5%, cichelli +5%)
+         but geometric mean is -0.09%.
+      Overall, a win.
+
+(SW3) Concerning (c), if we are wrapping the thing in extra value lambdas (in
+      abs_vars), then nothing is saved.  E.g.
+        f = \xyz. ...(e1[y],e2)....
+      If we float
+        lvl = \y. (e1[y],e2)
+        f = \xyz. ...(lvl y)...
+      we have saved nothing: one pair will still be allocated for each
+      call of `f`.  Hence the (not float_is_new_lam) in saves_work.
+
+Note [Saving allocation]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Even if `saves_work` is false, we we may want to float even cheap/HNF
+expressions out of value lambdas, for several reasons:
+
+* Doing so may save allocation. Consider
+        f = \x.  .. (\y.e) ...
+  Then we'd like to avoid allocating the (\y.e) every time we call f,
+  (assuming e does not mention x). An example where this really makes a
+  difference is simplrun009.
+
+* It may allow SpecContr to fire on functions. Consider
+        f = \x. ....(f (\y.e))....
+  After floating we get
+        lvl = \y.e
+        f = \x. ....(f lvl)...
+  Now it's easier for SpecConstr to generate a robust specialisation for f.
+
+* It makes the function smaller, and hence more likely to inline.  This can make
+  a big difference for string literals and bottoming expressions: see Note
+  [Floating to the top]
+
+Data suggests, however, that it is better /only/ to float HNFS, /if/ they can go
+to top level. See (SW2) of Note [Saving work].  If the expression goes to top
+level we don't pay the cost of allocating cold-path thunks described in (SW2).
+
+Hence `isTopLvl dest_lvl` in `saves_alloc`.
+
+Note [Floating to the top]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+Even though Note [Saving allocation] suggests that we should not, in
+general, float HNFs, the balance change if it goes to the top:
+
+* We don't pay an allocation cost for the floated expression; it
+  just becomes static data.
+
+* Floating string literal is valuable -- no point in duplicating the
+  at each call site!
+
+* Floating bottoming expressions is valuable: they are always cold
+  paths; we don't want to duplicate them at each call site; and they
+  can be quite big, inhibiting inlining. See Note [Bottoming floats]
+
+So we float an expression to the top if:
+  (a) the context is lazy (so we get allocation), or
+  (b) the expression is a HNF (so we get allocation), or
+  (c) the expression is bottoming and floating would escape a
+      value lambda (NB: if the expression itself is a lambda, (b)
+      will apply; so this case only catches bottoming thunks)
 
 Examples:
 
@@ -1127,33 +1200,6 @@ But *coercion* arguments aren’t (see Note [Coercion tokens] in
 "GHC.Core.Unfold"), so we still want to float out variables applied only to
 coercion arguments.
 
-Note [Escaping a value lambda]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We want to float even cheap expressions out of value lambdas,
-because that saves allocation.  Consider
-        f = \x.  .. (\y.e) ...
-Then we'd like to avoid allocating the (\y.e) every time we call f,
-(assuming e does not mention x). An example where this really makes a
-difference is simplrun009.
-
-Another reason it's good is because it makes SpecContr fire on functions.
-Consider
-        f = \x. ....(f (\y.e))....
-After floating we get
-        lvl = \y.e
-        f = \x. ....(f lvl)...
-and that is much easier for SpecConstr to generate a robust
-specialisation for.
-
-However, if we are wrapping the thing in extra value lambdas (in
-abs_vars), then nothing is saved.  E.g.
-        f = \xyz. ...(e1[y],e2)....
-If we float
-        lvl = \y. (e1[y],e2)
-        f = \xyz. ...(lvl y)...
-we have saved nothing: one pair will still be allocated for each
-call of 'f'.  Hence the (not float_is_lam) in float_me.
-
 
 ************************************************************************
 *                                                                      *


=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -116,7 +116,7 @@ type instance XFunBind    (GhcPass pL) GhcTc = (HsWrapper, [CoreTickish])
 -- type         Int -> forall a'. a' -> a'
 -- Notice that the coercion captures the free a'.
 
-type instance XPatBind    GhcPs (GhcPass pR) = [AddEpAnn]
+type instance XPatBind    GhcPs (GhcPass pR) = NoExtField
 type instance XPatBind    GhcRn (GhcPass pR) = NameSet -- See Note [Bind free vars]
 type instance XPatBind    GhcTc (GhcPass pR) =
     ( Type                  -- Type of the GRHSs


=====================================
compiler/GHC/Parser.y
=====================================
@@ -2585,7 +2585,7 @@ decl_no_th :: { LHsDecl GhcPs }
                                           ; !cs <- getCommentsFor l
                                           ; return $! (sL (commentsA l cs) $ ValD noExtField r) } }
         | PREFIX_PERCENT atype infixexp     opt_sig rhs  {% runPV (unECP $3) >>= \ $3 ->
-                                       do { let { l = comb2 $3 $> }
+                                       do { let { l = comb2 $1 $> }
                                           ; r <- checkValDef l $3 (mkMultAnn (epTok $1) $2, $4) $5;
                                         -- parses bindings of the form %p x or
                                         -- %p x :: sig


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1322,7 +1322,7 @@ checkValDef loc lhs (mult, Just (sigAnn, sig)) grhss
         -- x :: ty = rhs  parses as a *pattern* binding
   = do lhs' <- runPV $ mkHsTySigPV (combineLocsA lhs sig) lhs sig [sigAnn]
                         >>= checkLPat
-       checkPatBind loc [] lhs' grhss mult
+       checkPatBind loc lhs' grhss mult
 
 checkValDef loc lhs (mult_ann, Nothing) grhss
   | HsNoMultAnn{} <- mult_ann
@@ -1333,12 +1333,12 @@ checkValDef loc lhs (mult_ann, Nothing) grhss
                            fun is_infix pats grhss
             Nothing -> do
               lhs' <- checkPattern lhs
-              checkPatBind loc [] lhs' grhss mult_ann }
+              checkPatBind loc lhs' grhss mult_ann }
 
 checkValDef loc lhs (mult_ann, Nothing) ghrss
         -- %p x = rhs  parses as a *pattern* binding
   = do lhs' <- checkPattern lhs
-       checkPatBind loc [] lhs' ghrss mult_ann
+       checkPatBind loc lhs' ghrss mult_ann
 
 checkFunBind :: SrcStrictness
              -> SrcSpan
@@ -1376,15 +1376,14 @@ makeFunBind fn ms
 
 -- See Note [FunBind vs PatBind]
 checkPatBind :: SrcSpan
-             -> [AddEpAnn]
              -> LPat GhcPs
              -> Located (GRHSs GhcPs (LHsExpr GhcPs))
              -> HsMultAnn GhcPs
              -> P (HsBind GhcPs)
-checkPatBind loc annsIn (L _ (BangPat ans (L _ (VarPat _ v))))
+checkPatBind loc (L _ (BangPat ans (L _ (VarPat _ v))))
                         (L _match_span grhss) (HsNoMultAnn _)
       = return (makeFunBind v (L (noAnnSrcSpan loc)
-                [L (noAnnSrcSpan loc) (m (ans++annsIn) v)]))
+                [L (noAnnSrcSpan loc) (m ans v)]))
   where
     m a v = Match { m_ext = a
                   , m_ctxt = FunRhs { mc_fun    = v
@@ -1393,8 +1392,8 @@ checkPatBind loc annsIn (L _ (BangPat ans (L _ (VarPat _ v))))
                   , m_pats = []
                  , m_grhss = grhss }
 
-checkPatBind _loc annsIn lhs (L _ grhss) mult = do
-  return (PatBind annsIn lhs mult grhss)
+checkPatBind _loc lhs (L _ grhss) mult = do
+  return (PatBind noExtField lhs mult grhss)
 
 
 checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)
@@ -3317,12 +3316,12 @@ withCombinedComments ::
   HasLoc l2 =>
   l1 ->
   l2 ->
-  (SrcSpan -> EpAnnComments -> P a) ->
+  (SrcSpan -> P a) ->
   P (LocatedA a)
 withCombinedComments start end use = do
   cs <- getCommentsFor fullSpan
-  a <- use fullSpan cs
-  pure (L (noAnnSrcSpan fullSpan) a)
+  a <- use fullSpan
+  pure (L (EpAnn (spanAsAnchor fullSpan) noAnn cs) a)
   where
     fullSpan = combineSrcSpans (getHasLoc start) (getHasLoc end)
 
@@ -3362,15 +3361,14 @@ mkTupleSyntaxTycon boxity n =
 mkListSyntaxTy0 :: EpaLocation
                 -> EpaLocation
                 -> SrcSpan
-                -> EpAnnComments
                 -> P (HsType GhcPs)
-mkListSyntaxTy0 brkOpen brkClose span comments =
+mkListSyntaxTy0 brkOpen brkClose span =
   punsIfElse enabled disabled
   where
     enabled = HsTyVar noAnn NotPromoted rn
 
     -- attach the comments only to the RdrName since it's the innermost AST node
-    rn = L (EpAnn fullLoc rdrNameAnn comments) listTyCon_RDR
+    rn = L (EpAnn fullLoc rdrNameAnn emptyComments) listTyCon_RDR
 
     disabled =
       HsExplicitListTy annsKeyword NotPromoted []


=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -218,7 +218,7 @@ cvtDec (TH.ValD pat body ds)
         ; returnJustLA $ Hs.ValD noExtField $
           PatBind { pat_lhs = pat'
                   , pat_rhs = GRHSs emptyComments body' ds'
-                  , pat_ext = noAnn
+                  , pat_ext = noExtField
                   , pat_mult = HsNoMultAnn noExtField
                   } }
 


=====================================
testsuite/driver/testglobals.py
=====================================
@@ -182,8 +182,6 @@ class TestConfig:
         self.threads = 1
 
         # An optional executable used to wrap target code execution
-        # When set tests which aren't marked with TestConfig.cross_okay
-        # are skipped.
         self.target_wrapper = None
 
         # tests which should be considered to be broken during this testsuite
@@ -460,12 +458,6 @@ class TestOptions:
        # Should we copy the files of symlink the files for the test?
        self.copy_files = False
 
-       # Should the test be run in a cross-compiled tree?
-       #   None:  infer from test function
-       #   True:  run when --target-wrapper is set
-       #   False: do not run in cross-compiled trees
-       self.cross_okay = None # type: Optional[bool]
-
        # The extra hadrian dependencies we need for this particular test
        self.hadrian_deps = set(["test:ghc"]) # type: Set[str]
 


=====================================
testsuite/driver/testlib.py
=====================================
@@ -91,8 +91,8 @@ def setLocalTestOpts(opts: TestOptions) -> None:
     global testopts_ctx_var
     testopts_ctx_var.set(opts)
 
-def isCross() -> bool:
-    """ Are we testing a cross-compiler? """
+def needsTargetWrapper() -> bool:
+    """ Do we need to use a target wrapper? """
     return config.target_wrapper is not None
 
 def isCompilerStatsTest() -> bool:
@@ -240,7 +240,7 @@ def req_dynamic_hs( name, opts ):
         opts.expect = 'fail'
 
 def req_interp( name, opts ):
-    if not config.have_interp or isCross():
+    if not config.have_interp or needsTargetWrapper():
         opts.expect = 'fail'
     # skip on wasm32, otherwise they show up as unexpected passes
     if arch('wasm32'):
@@ -346,11 +346,10 @@ def req_host_target_ghc( name, opts ):
     """
     When testing a cross GHC, some test cases require a host GHC as well (e.g.
     for compiling custom Setup.hs). This is not supported yet (#23236), so for
-    the time being we skip them when testing cross GHCs. However, this is not
-    the case for the JS backend. The JS backend is a cross-compiler that
-    produces code that the host can run.
+    the time being we skip them when testing cross GHCs. However, for cross targets
+    which don't need a target wrapper (e.g. javascript), we can still run these testcases.
     """
-    if isCross() and not js_arch():
+    if needsTargetWrapper():
         opts.skip = True
 
 has_ls_files = None
@@ -1290,21 +1289,18 @@ async def test_common_work(name: TestName, opts,
                 all_ways = [WayName('ghci'), WayName('ghci-opt')]
             else:
                 all_ways = []
-            if isCross():
-                opts.cross_okay = False
+            if needsTargetWrapper():
+                opts.skip = True
         elif func in [makefile_test, run_command]:
             # makefile tests aren't necessarily runtime or compile-time
             # specific. Assume we can run them in all ways. See #16042 for what
             # happened previously.
             all_ways = config.compile_ways + config.run_ways
-            if isCross():
-                opts.cross_okay = False
+            if needsTargetWrapper():
+                opts.skip = True
         else:
             all_ways = [WayName('normal')]
 
-        if isCross() and opts.cross_okay is False:
-            opts.skip = True
-
         # A test itself can request extra ways by setting opts.extra_ways
         all_ways = list(OrderedDict.fromkeys(all_ways + [way for way in opts.extra_ways if way not in all_ways]))
 


=====================================
testsuite/tests/linear/should_fail/LinearLet6.stderr
=====================================
@@ -13,7 +13,7 @@ LinearLet6.hs:10:3: error: [GHC-18872]
             where
                 (Just y) = x
 
-LinearLet6.hs:15:14: error: [GHC-18872]
+LinearLet6.hs:15:11: error: [GHC-18872]
     • Couldn't match type ‘Many’ with ‘One’
         arising from a non-linear pattern ‘Just y’
           (non-variable lazy pattern aren't linear)


=====================================
testsuite/tests/linear/should_fail/LinearLet7.stderr
=====================================
@@ -1,14 +1,14 @@
 
-LinearLet7.hs:6:14: error: [GHC-18872]
+LinearLet7.hs:6:11: error: [GHC-18872]
     • Couldn't match type ‘Many’ with ‘One’
-        arising from multiplicity of ‘g’
-    • In a pattern binding: g = \ y -> g y
-      In the expression: let %1 g = \ y -> ... in g x
+        arising from a non-linear pattern ‘_’
+          (non-variable pattern bindings that have been generalised aren't linear)
+    • In the expression: let %1 g = \ y -> ... in g x
       In an equation for ‘f’: f x = let %1 g = ... in g x
 
 LinearLet7.hs:6:14: error: [GHC-18872]
     • Couldn't match type ‘Many’ with ‘One’
-        arising from a non-linear pattern ‘_’
-          (non-variable pattern bindings that have been generalised aren't linear)
-    • In the expression: let %1 g = \ y -> ... in g x
+        arising from multiplicity of ‘g’
+    • In a pattern binding: g = \ y -> g y
+      In the expression: let %1 g = \ y -> ... in g x
       In an equation for ‘f’: f x = let %1 g = ... in g x


=====================================
testsuite/tests/printer/AnnotationNoListTuplePuns.hs
=====================================
@@ -1,17 +1,18 @@
 {-# language NoListTuplePuns #-}
+{-# OPTIONS -ddump-parsed-ast #-}
 module AnnotationNoListTuplePuns where
 
 type A =
-  -- comment pre
+  -- comment pre A
   [
-    -- comment inside
+    -- comment inside A
   ]
-  -- comment post
+  -- comment post A
 
 type B =
-  -- comment pre
+  -- comment pre B
   [
-    -- comment inside
+    -- comment inside B
     Bool
   ]
-  -- comment post
+  -- comment post B


=====================================
testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
=====================================
@@ -0,0 +1,323 @@
+
+==================== Parser AST ====================
+
+(L
+ { AnnotationNoListTuplePuns.hs:1:1 }
+ (HsModule
+  (XModulePs
+   (EpAnn
+    (EpaSpan { AnnotationNoListTuplePuns.hs:1:1 })
+    (AnnsModule
+     [(AddEpAnn AnnModule (EpaSpan { AnnotationNoListTuplePuns.hs:3:1-6 }))
+     ,(AddEpAnn AnnWhere (EpaSpan { AnnotationNoListTuplePuns.hs:3:34-38 }))]
+     []
+     []
+     (Just
+      ((,)
+       { AnnotationNoListTuplePuns.hs:19:1 }
+       { AnnotationNoListTuplePuns.hs:18:3-19 })))
+    (EpaCommentsBalanced
+     [(L
+       (EpaSpan
+        { AnnotationNoListTuplePuns.hs:1:1-32 })
+       (EpaComment
+        (EpaBlockComment
+         "{-# language NoListTuplePuns #-}")
+        { AnnotationNoListTuplePuns.hs:1:1 }))
+     ,(L
+       (EpaSpan
+        { AnnotationNoListTuplePuns.hs:2:1-33 })
+       (EpaComment
+        (EpaBlockComment
+         "{-# OPTIONS -ddump-parsed-ast #-}")
+        { AnnotationNoListTuplePuns.hs:1:1-32 }))]
+     [(L
+       (EpaSpan
+        { AnnotationNoListTuplePuns.hs:18:3-19 })
+       (EpaComment
+        (EpaLineComment
+         "-- comment post B")
+        { AnnotationNoListTuplePuns.hs:17:3 }))]))
+   (EpVirtualBraces
+    (1))
+   (Nothing)
+   (Nothing))
+  (Just
+   (L
+    (EpAnn
+     (EpaSpan { AnnotationNoListTuplePuns.hs:3:8-32 })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    {ModuleName: AnnotationNoListTuplePuns}))
+  (Nothing)
+  []
+  [(L
+    (EpAnn
+     (EpaSpan { AnnotationNoListTuplePuns.hs:(5,1)-(9,3) })
+     (AnnListItem
+      [])
+     (EpaComments
+      [(L
+        (EpaSpan
+         { AnnotationNoListTuplePuns.hs:6:3-18 })
+        (EpaComment
+         (EpaLineComment
+          "-- comment pre A")
+         { AnnotationNoListTuplePuns.hs:5:8 }))]))
+    (TyClD
+     (NoExtField)
+     (SynDecl
+      [(AddEpAnn AnnType (EpaSpan { AnnotationNoListTuplePuns.hs:5:1-4 }))
+      ,(AddEpAnn AnnEqual (EpaSpan { AnnotationNoListTuplePuns.hs:5:8 }))]
+      (L
+       (EpAnn
+        (EpaSpan { AnnotationNoListTuplePuns.hs:5:6 })
+        (NameAnnTrailing
+         [])
+        (EpaComments
+         []))
+       (Unqual
+        {OccName: A}))
+      (HsQTvs
+       (NoExtField)
+       [])
+      (Prefix)
+      (L
+       (EpAnn
+        (EpaSpan { AnnotationNoListTuplePuns.hs:(7,3)-(9,3) })
+        (AnnListItem
+         [])
+        (EpaComments
+         [(L
+           (EpaSpan
+            { AnnotationNoListTuplePuns.hs:8:5-23 })
+           (EpaComment
+            (EpaLineComment
+             "-- comment inside A")
+            { AnnotationNoListTuplePuns.hs:7:3 }))]))
+       (HsExplicitListTy
+        [(AddEpAnn AnnOpenS (EpaSpan { AnnotationNoListTuplePuns.hs:7:3 }))
+        ,(AddEpAnn AnnCloseS (EpaSpan { AnnotationNoListTuplePuns.hs:9:3 }))]
+        (NotPromoted)
+        [])))))
+  ,(L
+    (EpAnn
+     (EpaSpan { AnnotationNoListTuplePuns.hs:(12,1)-(17,3) })
+     (AnnListItem
+      [])
+     (EpaComments
+      [(L
+        (EpaSpan
+         { AnnotationNoListTuplePuns.hs:10:3-19 })
+        (EpaComment
+         (EpaLineComment
+          "-- comment post A")
+         { AnnotationNoListTuplePuns.hs:9:3 }))
+      ,(L
+        (EpaSpan
+         { AnnotationNoListTuplePuns.hs:13:3-18 })
+        (EpaComment
+         (EpaLineComment
+          "-- comment pre B")
+         { AnnotationNoListTuplePuns.hs:12:8 }))]))
+    (TyClD
+     (NoExtField)
+     (SynDecl
+      [(AddEpAnn AnnType (EpaSpan { AnnotationNoListTuplePuns.hs:12:1-4 }))
+      ,(AddEpAnn AnnEqual (EpaSpan { AnnotationNoListTuplePuns.hs:12:8 }))]
+      (L
+       (EpAnn
+        (EpaSpan { AnnotationNoListTuplePuns.hs:12:6 })
+        (NameAnnTrailing
+         [])
+        (EpaComments
+         []))
+       (Unqual
+        {OccName: B}))
+      (HsQTvs
+       (NoExtField)
+       [])
+      (Prefix)
+      (L
+       (EpAnn
+        (EpaSpan { AnnotationNoListTuplePuns.hs:(14,3)-(17,3) })
+        (AnnListItem
+         [])
+        (EpaComments
+         [(L
+           (EpaSpan
+            { AnnotationNoListTuplePuns.hs:15:5-23 })
+           (EpaComment
+            (EpaLineComment
+             "-- comment inside B")
+            { AnnotationNoListTuplePuns.hs:14:3 }))]))
+       (HsExplicitListTy
+        [(AddEpAnn AnnOpenS (EpaSpan { AnnotationNoListTuplePuns.hs:14:3 }))
+        ,(AddEpAnn AnnCloseS (EpaSpan { AnnotationNoListTuplePuns.hs:17:3 }))]
+        (NotPromoted)
+        [(L
+          (EpAnn
+           (EpaSpan { AnnotationNoListTuplePuns.hs:16:5-8 })
+           (AnnListItem
+            [])
+           (EpaComments
+            []))
+          (HsTyVar
+           []
+           (NotPromoted)
+           (L
+            (EpAnn
+             (EpaSpan { AnnotationNoListTuplePuns.hs:16:5-8 })
+             (NameAnnTrailing
+              [])
+             (EpaComments
+              []))
+            (Unqual
+             {OccName: Bool}))))])))))]))
+
+
+
+==================== Parser AST ====================
+
+(L
+ { AnnotationNoListTuplePuns.ppr.hs:1:1 }
+ (HsModule
+  (XModulePs
+   (EpAnn
+    (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:1:1 })
+    (AnnsModule
+     [(AddEpAnn AnnModule (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:1-6 }))
+     ,(AddEpAnn AnnWhere (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:34-38 }))]
+     []
+     []
+     (Just
+      ((,)
+       { AnnotationNoListTuplePuns.ppr.hs:5:16 }
+       { AnnotationNoListTuplePuns.ppr.hs:5:15 })))
+    (EpaCommentsBalanced
+     [(L
+       (EpaSpan
+        { AnnotationNoListTuplePuns.ppr.hs:1:1-32 })
+       (EpaComment
+        (EpaBlockComment
+         "{-# language NoListTuplePuns #-}")
+        { AnnotationNoListTuplePuns.ppr.hs:1:1 }))
+     ,(L
+       (EpaSpan
+        { AnnotationNoListTuplePuns.ppr.hs:2:1-33 })
+       (EpaComment
+        (EpaBlockComment
+         "{-# OPTIONS -ddump-parsed-ast #-}")
+        { AnnotationNoListTuplePuns.ppr.hs:1:1-32 }))]
+     []))
+   (EpVirtualBraces
+    (1))
+   (Nothing)
+   (Nothing))
+  (Just
+   (L
+    (EpAnn
+     (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:8-32 })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    {ModuleName: AnnotationNoListTuplePuns}))
+  (Nothing)
+  []
+  [(L
+    (EpAnn
+     (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:1-11 })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    (TyClD
+     (NoExtField)
+     (SynDecl
+      [(AddEpAnn AnnType (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:1-4 }))
+      ,(AddEpAnn AnnEqual (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:8 }))]
+      (L
+       (EpAnn
+        (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:6 })
+        (NameAnnTrailing
+         [])
+        (EpaComments
+         []))
+       (Unqual
+        {OccName: A}))
+      (HsQTvs
+       (NoExtField)
+       [])
+      (Prefix)
+      (L
+       (EpAnn
+        (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:10-11 })
+        (AnnListItem
+         [])
+        (EpaComments
+         []))
+       (HsExplicitListTy
+        [(AddEpAnn AnnOpenS (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:10 }))
+        ,(AddEpAnn AnnCloseS (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:11 }))]
+        (NotPromoted)
+        [])))))
+  ,(L
+    (EpAnn
+     (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:1-15 })
+     (AnnListItem
+      [])
+     (EpaComments
+      []))
+    (TyClD
+     (NoExtField)
+     (SynDecl
+      [(AddEpAnn AnnType (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:1-4 }))
+      ,(AddEpAnn AnnEqual (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:8 }))]
+      (L
+       (EpAnn
+        (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:6 })
+        (NameAnnTrailing
+         [])
+        (EpaComments
+         []))
+       (Unqual
+        {OccName: B}))
+      (HsQTvs
+       (NoExtField)
+       [])
+      (Prefix)
+      (L
+       (EpAnn
+        (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:10-15 })
+        (AnnListItem
+         [])
+        (EpaComments
+         []))
+       (HsExplicitListTy
+        [(AddEpAnn AnnOpenS (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:10 }))
+        ,(AddEpAnn AnnCloseS (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:15 }))]
+        (NotPromoted)
+        [(L
+          (EpAnn
+           (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:11-14 })
+           (AnnListItem
+            [])
+           (EpaComments
+            []))
+          (HsTyVar
+           []
+           (NotPromoted)
+           (L
+            (EpAnn
+             (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:11-14 })
+             (NameAnnTrailing
+              [])
+             (EpaComments
+              []))
+            (Unqual
+             {OccName: Bool}))))])))))]))
+
+


=====================================
testsuite/tests/simplCore/should_compile/T18013.stderr
=====================================
@@ -131,9 +131,9 @@ Rule fired: Class op fmap (BUILTIN)
 
 ==================== Tidy Core ====================
 Result size of Tidy Core
-  = {terms: 38, types: 90, coercions: 17, joins: 0/1}
+  = {terms: 36, types: 86, coercions: 17, joins: 0/0}
 
--- RHS size: {terms: 37, types: 78, coercions: 17, joins: 0/1}
+-- RHS size: {terms: 35, types: 74, coercions: 17, joins: 0/0}
 mapMaybeRule [InlPrag=[2]]
   :: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b)
 [GblId,
@@ -182,12 +182,6 @@ mapMaybeRule [InlPrag=[2]]
 mapMaybeRule
   = \ (@a) (@b) (f :: Rule IO a b) ->
       case f of { Rule @s ww ww1 ->
-      let {
-        lvl :: Result s (Maybe b)
-        [LclId, Unf=OtherCon []]
-        lvl
-          = T18013a.Result
-              @s @(Maybe b) ww (GHC.Internal.Maybe.Nothing @b) } in
       T18013a.Rule
         @IO
         @(Maybe a)
@@ -198,7 +192,9 @@ mapMaybeRule
             (a1 :: Maybe a)
             (s1 :: GHC.Prim.State# GHC.Prim.RealWorld) ->
             case a1 of {
-              Nothing -> (# s1, lvl #);
+              Nothing ->
+                (# s1,
+                   T18013a.Result @s @(Maybe b) ww (GHC.Internal.Maybe.Nothing @b) #);
               Just x ->
                 case ((ww1 s2 x)
                       `cast` <Co:4> :: IO (Result s b)


=====================================
testsuite/tests/simplCore/should_run/simplrun009.hs
=====================================
@@ -6,7 +6,7 @@
 -- It produces a nested unfold that should look something
 -- like the code below.  Note the 'lvl1_shW'.  It is BAD
 -- if this is a lambda instead; you get a lot more allocation
--- See Note [Escaping a value lambda] in GHC.Core.Opt.SetLevels
+-- See Note [Saving allocation] in GHC.Core.Opt.SetLevels
 
 
 {-



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92a14a49f94a0d6838617dd97668597b372653d6...2e42e6e0d79b39ad8f611b61e1fae0934c5589b8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92a14a49f94a0d6838617dd97668597b372653d6...2e42e6e0d79b39ad8f611b61e1fae0934c5589b8
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/20240418/1a545b1d/attachment-0001.html>


More information about the ghc-commits mailing list