[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Remove obsolete cross-port script

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Nov 13 15:21:29 UTC 2024



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


Commits:
00d551bf by Cheng Shao at 2024-11-13T08:48:21-05:00
Remove obsolete cross-port script

This patch removes the obsolete cross-port script in the tree. The
script was based on the legacy Make build system which has been pruned
from the tree long ago. For hadrian, proper support for two-stage
bootstrapping onto a new unsupported platform is a work in progress in
!11444.

- - - - -
75a2eae4 by Cheng Shao at 2024-11-13T08:48:58-05:00
hadrian: fix bindist makefile for wasm32-wasi target

This patch fixes one incoherent place between bindist makefile and
hadrian logic: I forgot to include wasi/wasm32 in
OsSupportsGHCi/ArchSupportsGHCi as well. And this results in incorrect
settings file generated after installing the bindist, and "Use
interpreter"/"Have interpreter" fields incorrectly have "NO" values
where they should be "YES" like --info output of in-tree version.

- - - - -
0614abef by Alan Zimmerman at 2024-11-13T08:49:34-05:00
EPA: Correctly capture leading semis in decl list

Closes #25467

- - - - -
a876f9e1 by Sebastian Graf at 2024-11-13T10:21:14-05:00
DmdAnal: Make `prompt#` lazy (#25439)

This applies the same treatment to `prompt#` as for `catch#`.
See `Note [Strictness for mask/unmask/catch/prompt]`.

Fixes #25439.

- - - - -
a1da8094 by Ben Gamari at 2024-11-13T10:21:16-05:00
boot: Do not attempt to update config.sub

While Apple ARM hardware was new we found that the autoconf scripts
included in some boot packages were too old. As a mitigation for this,
we introduced logic in the `boot` script to update the `config.sub`
with that from the GHC tree. However, this causes submodules which
have `config.sub` committted to appear to be dirty. This is a
considerable headache.

Now since `config.sub` with full platform support is more common we can
remove `boot`'s `config.sub` logic.

Fixes #19574.

- - - - -


14 changed files:

- boot
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Parser.y
- − distrib/cross-port
- hadrian/bindist/config.mk.in
- + testsuite/tests/dmdanal/should_run/T25439.hs
- + testsuite/tests/dmdanal/should_run/T25439.stdout
- testsuite/tests/dmdanal/should_run/all.T
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/printer/Makefile
- testsuite/tests/printer/Test20297.stdout
- + testsuite/tests/printer/Test25467.hs
- testsuite/tests/printer/all.T
- utils/check-exact/Main.hs


Changes:

=====================================
boot
=====================================
@@ -66,9 +66,6 @@ def autoreconf():
     for dir_ in ['.', 'rts'] + glob.glob('libraries/*/'):
         if os.path.isfile(os.path.join(dir_, 'configure.ac')):
             print("Booting %s" % dir_)
-            # Update config.sub in submodules
-            if dir_ != '.' and os.path.isfile(os.path.join(dir_, 'config.sub')):
-                shutil.copyfile('config.sub', os.path.join(dir_, 'config.sub'))
             processes[dir_] = subprocess.Popen(['sh', '-c', reconf_cmd], cwd=dir_)
 
     # Wait for all child processes to finish.


=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -2663,18 +2663,45 @@ primop  CasMutVarOp "casMutVar#" GenPrimOp
 section "Exceptions"
 ------------------------------------------------------------------------
 
--- Note [Strictness for mask/unmask/catch]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Note [Strict IO wrappers]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~
 -- Consider this example, which comes from GHC.IO.Handle.Internals:
---    wantReadableHandle3 f ma b st
+--    wantReadableHandle3 f mv b st
 --      = case ... of
---          DEFAULT -> case ma of MVar a -> ...
---          0#      -> maskAsyncExceptions# (\st -> case ma of MVar a -> ...)
+--          DEFAULT -> case mv of MVar a -> ...
+--          0#      -> maskAsyncExceptions# (\st -> case mv of MVar a -> ...)
 -- The outer case just decides whether to mask exceptions, but we don't want
--- thereby to hide the strictness in 'ma'!  Hence the use of strictOnceApply1Dmd
--- in mask and unmask. But catch really is lazy in its first argument, see
--- #11555. So for IO actions 'ma' we often use a wrapper around it that is
--- head-strict in 'ma': GHC.IO.catchException.
+-- thereby to hide the strictness in `mv`!  Hence the use of strictOnceApply1Dmd
+-- in mask#, unmask# and atomically# (where we use strictManyApply1Dmd to respect
+-- that it potentially calls its action multiple times).
+--
+-- Note [Strictness for catch-style primops]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The catch#-style primops always call their action, just like outlined
+-- in Note [Strict IO wrappers].
+-- However, it is important that we give their first arg lazyApply1Dmd and not
+-- strictOnceApply1Dmd, like for mask#. Here is why. Consider a call
+--
+--   catch# act handler s
+--
+-- If `act = raiseIO# ...`, using strictOnceApply1Dmd for `act` would mean that
+-- the call forwards the dead-end flag from `act` (see Note [Dead ends] and
+-- Note [Precise exceptions and strictness analysis]).
+-- This would cause dead code elimination to discard the continuation of the
+-- catch# call, among other things. This first came up in #11555.
+--
+-- Hence catch# uses lazyApply1Dmd in order /not/ to forward the dead-end flag
+-- from `act`. (This is a bit brutal, but the language of strictness types is
+-- not expressive enough to give it a more precise semantics that is still
+-- sound.)
+-- For perf reasons we often (but not always) choose to use a wrapper around
+-- catch# that is head-strict in `act`: GHC.IO.catchException.
+--
+-- A similar caveat applies to prompt#, which can be seen as a
+-- generalisation of catch# as explained in GHC.Prim#continuations#.
+-- The reason is that even if `act` appears dead-ending (e.g., looping)
+-- `prompt# tag ma s` might return alright due to a (higher-order) use of
+-- `control0#` in `act`. This came up in #25439.
 
 primop  CatchOp "catch#" GenPrimOp
           (State# RealWorld -> (# State# RealWorld, a_reppoly #) )
@@ -2691,7 +2718,7 @@ primop  CatchOp "catch#" GenPrimOp
    strictness  = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
                                                  , lazyApply2Dmd
                                                  , topDmd] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strictness for catch-style primops]
    out_of_line = True
    effect = ReadWriteEffect
    -- Either inner computation might potentially raise an unchecked exception,
@@ -2757,7 +2784,7 @@ primop  MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp
      in continuation-style primops\" for details. }
    with
    strictness  = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strict IO wrappers]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -2772,6 +2799,7 @@ primop  MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp
      in continuation-style primops\" for details. }
    with
    strictness  = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
+                 -- See Note [Strict IO wrappers]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -2786,7 +2814,7 @@ primop  UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp
      in continuation-style primops\" for details. }
    with
    strictness  = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strict IO wrappers]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -2972,7 +3000,8 @@ primop  PromptOp "prompt#" GenPrimOp
      -> State# RealWorld -> (# State# RealWorld, a #)
    { See "GHC.Prim#continuations". }
    with
-   strictness = { \ _arity -> mkClosedDmdSig [topDmd, strictOnceApply1Dmd, topDmd] topDiv }
+   strictness = { \ _arity -> mkClosedDmdSig [topDmd, lazyApply1Dmd, topDmd] topDiv }
+                 -- See Note [Strictness for catch-style primops]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -3000,7 +3029,7 @@ primop  AtomicallyOp "atomically#" GenPrimOp
    -> State# RealWorld -> (# State# RealWorld, a_levpoly #)
    with
    strictness  = { \ _arity -> mkClosedDmdSig [strictManyApply1Dmd,topDmd] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strict IO wrappers]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -3029,7 +3058,7 @@ primop  CatchRetryOp "catchRetry#" GenPrimOp
    strictness  = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
                                                  , lazyApply1Dmd
                                                  , topDmd ] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strictness for catch-style primops]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -3041,7 +3070,7 @@ primop  CatchSTMOp "catchSTM#" GenPrimOp
    strictness  = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
                                                  , lazyApply2Dmd
                                                  , topDmd ] topDiv }
-                 -- See Note [Strictness for mask/unmask/catch]
+                 -- See Note [Strictness for catch-style primops]
    out_of_line = True
    effect = ReadWriteEffect
 
@@ -3731,6 +3760,7 @@ primop KeepAliveOp "keepAlive#" GenPrimOp
    with
    out_of_line = True
    strictness = { \ _arity -> mkClosedDmdSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv }
+                 -- See Note [Strict IO wrappers]
    effect = ReadWriteEffect
    -- The invoked computation may have side effects
 


=====================================
compiler/GHC/Parser.y
=====================================
@@ -1853,7 +1853,7 @@ where_inst :: { Located ((EpToken "where", (EpToken "{", EpToken "}", [EpToken "
 --
 decls   :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) }
         : decls ';' decl    {% if isNilOL (thdOf3 $ unLoc $1)
-                                 then return (sLL $1 $> (glEE $2 $3, (sndOf3 $ unLoc $1) ++ (msemiA $2)
+                                 then return (sLL $2 $> (glR $3, (sndOf3 $ unLoc $1) ++ (msemiA $2)
                                                         , unitOL $3))
                                  else case (thdOf3 $ unLoc $1) of
                                    SnocOL hs t -> do
@@ -1862,7 +1862,7 @@ decls   :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) }
                                             rest = snocOL hs t';
                                             these = rest `appOL` this }
                                       return (rest `seq` this `seq` these `seq`
-                                                 (sLL $1 $> (glEE $1 $3, sndOf3 $ unLoc $1, these))) }
+                                                 (sLL $1 $> (glEE (fstOf3 $ unLoc $1) $3, sndOf3 $ unLoc $1, these))) }
         | decls ';'          {% if isNilOL (thdOf3 $ unLoc $1)
                                   then return (sLZ $1 $> (glR $2, (sndOf3 $ unLoc $1) ++ (msemiA $2)
                                                           ,thdOf3 $ unLoc $1))
@@ -1876,7 +1876,7 @@ decls   :: { Located (EpaLocation, [EpToken ";"], OrdList (LHsDecl GhcPs)) }
 decllist :: { Located (AnnList (),Located (OrdList (LHsDecl GhcPs))) }
         : '{'            decls '}'     { sLL $1 $> (AnnList (Just (fstOf3 $ unLoc $2)) (ListBraces (epTok $1) (epTok $3)) (sndOf3 $ unLoc $2) noAnn []
                                                    ,sL1 $2 $ thdOf3 $ unLoc $2) }
-        |     vocurly    decls close   { L (getHasLoc $ fstOf3 $ unLoc $2) (AnnList (Just (glR $2)) ListNone (sndOf3 $ unLoc $2) noAnn []
+        |     vocurly    decls close   { sL1 $2    (AnnList (Just (fstOf3 $ unLoc $2)) ListNone (sndOf3 $ unLoc $2) noAnn []
                                                    ,sL1 $2 $ thdOf3 $ unLoc $2) }
 
 -- Binding groups other than those of class and instance declarations


=====================================
distrib/cross-port deleted
=====================================
@@ -1,75 +0,0 @@
-#!/usr/bin/env bash
-
-# This script can be used to generate some unregisterised .hc files
-# for bootstrapping GHC on a new/unsupported platform.  It involves a
-# two-stage bootstrap: the first stage builds an unregisterised set of
-# libraries & RTS, and the second stage builds an unregisterised
-# compiler.  
-
-# Take the .hc files from the libraries of stage 1, and the compiler
-# of stage 2, to the target system and bootstrap from these to get a
-# working (unregisterised) compiler.
-
-set -e
-
-base=`pwd`
-
-# set this to the location of your source tree
-fptools_dir=$HOME/fptools
-
-if [ ! -f b1-stamp ]; then
-  mkdir b1
-  cd b1
-  lndir $fptools_dir
-  cd ..
-
-  cd b1
-   ./configure
-
-   # For cross-compilation, at this stage you may want to set up a source
-   # tree on the target machine, run the configure script there, and bring
-   # the resulting rts/ghcautoconf.h.autoconf file back into this tree before building
-   # the libraries.
-
-   touch mk/build.mk
-   echo "GhcUnregisterised = YES" >> mk/build.mk
-   echo "GhcLibHcOpts = -O -H32m -fvia-C -keep-hc-files" >> mk/build.mk
-   echo "GhcLibWays =" >> mk/build.mk
-
-   # We could optimise slightly by not building hslibs here.  Also, building
-   # the RTS is not necessary (and might not be desirable if we're using
-   # a ghcautoconf.h from the target system).
-   make stage1
-
-  cd ..
-
-  touch b1-stamp
-fi
-
-# exit 0
-
-if [ ! -f b2-stamp ]; then
-  mkdir b2
-  cd b2
-  lndir $fptools_dir
-  cd ..
-
-  cd b2
-   ./configure --with-ghc=$base/b1/ghc/compiler/stage1/ghc-inplace
-
-   touch mk/build.mk
-   # The bootstrapped compiler should probably generate unregisterised
-   # code too.  If you don't want it to, then comment out this line:
-   echo "GhcUnregisterised = YES" >> mk/build.mk
-   echo "SRC_HC_OPTS += -keep-hc-file -fvia-C" >> mk/build.mk
-   echo "GhcWithInterpreter = NO" >> mk/build.mk
-
-   # we just need to build the compiler and utils...
-   (cd glafp-utils && make boot && make)
-   (cd ghc && make boot)
-   (cd ghc/utils && make)
-   (cd ghc/compiler && make stage=1)
-  cd ..
-
-  touch b2-stamp
-fi


=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -147,8 +147,8 @@ endif
 
 # Whether to include GHCi in the compiler.  Depends on whether the RTS linker
 # has support for this OS/ARCH combination.
-OsSupportsGHCi=$(strip $(patsubst $(TargetOS_CPP), YES, $(findstring $(TargetOS_CPP), mingw32 linux solaris2 freebsd dragonfly netbsd openbsd darwin kfreebsdgnu)))
-ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc powerpc64 powerpc64le sparc sparc64 arm aarch64 riscv64)))
+OsSupportsGHCi=$(strip $(patsubst $(TargetOS_CPP), YES, $(findstring $(TargetOS_CPP), mingw32 linux solaris2 freebsd dragonfly netbsd openbsd darwin kfreebsdgnu wasi)))
+ArchSupportsGHCi=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 powerpc powerpc64 powerpc64le sparc sparc64 arm aarch64 riscv64 wasm32)))
 
 ifeq "$(OsSupportsGHCi)$(ArchSupportsGHCi)" "YESYES"
 GhcWithInterpreter=YES


=====================================
testsuite/tests/dmdanal/should_run/T25439.hs
=====================================
@@ -0,0 +1,25 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, BlockArguments #-}
+
+import Prelude hiding (break)
+import GHC.Exts (PromptTag#, newPromptTag#, prompt#, control0#)
+import GHC.IO (IO(..), unIO)
+import Control.Monad (forever)
+
+main :: IO ()
+main = do
+  putStrLn "before"
+  broken >>= putStrLn
+  putStrLn "after"
+
+broken :: IO String
+broken = do
+  loop \l -> do
+    break l "broken"
+
+{-# NOINLINE loop #-}
+loop :: (PromptTag# a -> IO ()) -> IO a
+loop f = IO \rw0 -> case newPromptTag# rw0 of
+  (# rw1, tag #) -> prompt# tag (unIO (forever (f tag))) rw1
+
+break :: PromptTag# a -> a -> IO b
+break tag x = IO (control0# tag \_ rw1 -> (# rw1, x #))


=====================================
testsuite/tests/dmdanal/should_run/T25439.stdout
=====================================
@@ -0,0 +1,3 @@
+before
+broken
+after


=====================================
testsuite/tests/dmdanal/should_run/all.T
=====================================
@@ -33,3 +33,4 @@ test('T22475b', normal, compile_and_run, [''])
 # T22549: Do not strictify DFuns, otherwise we will <<loop>>
 test('T22549', normal, compile_and_run, ['-fdicts-strict -fno-specialise'])
 test('T23208', exit_code(1), multimod_compile_and_run, ['T23208_Lib', 'T23208'])
+test('T25439', normal, compile_and_run, [''])


=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -1971,7 +1971,7 @@
                    (EpaSpan { DumpSemis.hs:34:13-31 })
                    (AnnList
                     (Just
-                     (EpaSpan { DumpSemis.hs:34:14-30 }))
+                     (EpaSpan { DumpSemis.hs:34:18-30 }))
                     (ListBraces
                      (EpTok (EpaSpan { DumpSemis.hs:34:13 }))
                      (EpTok (EpaSpan { DumpSemis.hs:34:31 })))


=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -891,3 +891,8 @@ Test25132:
 Test25454:
 	$(CHECK_PPR)   $(LIBDIR) Test25454.hs
 	$(CHECK_EXACT) $(LIBDIR) Test25454.hs
+
+.PHONY: Test25467
+Test25467:
+	$(CHECK_PPR)   $(LIBDIR) Test25467.hs
+	$(CHECK_EXACT) $(LIBDIR) Test25467.hs


=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -153,7 +153,7 @@
               (EpaSpan { <no location info> })
               (AnnList
                (Just
-                (EpaSpan { <no location info> }))
+                (EpaSpan { Test20297.hs:7:3-7 }))
                (ListNone)
                []
                (EpTok
@@ -582,7 +582,7 @@
               (EpaSpan { <no location info> })
               (AnnList
                (Just
-                (EpaSpan { <no location info> }))
+                (EpaSpan { Test20297.ppr.hs:5:3-7 }))
                (ListNone)
                []
                (EpTok


=====================================
testsuite/tests/printer/Test25467.hs
=====================================
@@ -0,0 +1,21 @@
+module Test25467 where
+
+fff = do
+     let {
+         ; (a, b) = foo
+         }
+     pure ()
+
+foo = do
+  let ;x =1
+
+bar1 = do
+    let {
+        ; labels1     = getFieldLabels
+        ; argexprA    = vhdlNameToVHDLExpr
+        }
+
+bar2 = do
+    let {
+        ; labels2      = getFieldLabels
+        }


=====================================
testsuite/tests/printer/all.T
=====================================
@@ -210,6 +210,7 @@ test('Test24753', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24753'])
 test('Test24771', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24771'])
 test('Test24159', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24159'])
 test('Test25132', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25132'])
+test('Test25467', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25467'])
 
 test('T24237', normal, compile_fail, [''])
 


=====================================
utils/check-exact/Main.hs
=====================================
@@ -213,10 +213,11 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_buil
  -- "../../testsuite/tests/printer/Test16279.hs" Nothing
  -- "../../testsuite/tests/printer/HsDocTy.hs" Nothing
  -- "../../testsuite/tests/printer/Test21355.hs" Nothing
---  "../../testsuite/tests/printer/Test22765.hs" Nothing
+ --  "../../testsuite/tests/printer/Test22765.hs" Nothing
  -- "../../testsuite/tests/printer/Test22771.hs" Nothing
  -- "../../testsuite/tests/printer/Test23465.hs" Nothing
- "../../testsuite/tests/printer/Test25454.hs" Nothing
+ -- "../../testsuite/tests/printer/Test25454.hs" Nothing
+ "../../testsuite/tests/printer/Test25467.hs" Nothing
 
 -- cloneT does not need a test, function can be retired
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c008da428280ff0be8067cac270cd3c6279b4a19...a1da8094757146c215b86bbe029b65a34151154a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c008da428280ff0be8067cac270cd3c6279b4a19...a1da8094757146c215b86bbe029b65a34151154a
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/20241113/8280b239/attachment-0001.html>


More information about the ghc-commits mailing list