[Git][ghc/ghc][wip/andreask/late_workfree] 6 commits: ghc-bignum: remove obsolete ln script

Andreas Klebinger (@AndreasK) gitlab at gitlab.haskell.org
Thu May 2 17:55:54 UTC 2024



Andreas Klebinger pushed to branch wip/andreask/late_workfree at Glasgow Haskell Compiler / GHC


Commits:
c62dc317 by Cheng Shao at 2024-04-25T01:32:02-04:00
ghc-bignum: remove obsolete ln script

This commit removes an obsolete ln script in ghc-bignum/gmp. See
060251c24ad160264ae8553efecbb8bed2f06360 for its original intention,
but it's been obsolete for a long time, especially since the removal
of the make build system. Hence the house cleaning.

- - - - -
6399d52b by Cheng Shao at 2024-04-25T01:32:02-04:00
ghc-bignum: update gmp to 6.3.0

This patch bumps the gmp-tarballs submodule and updates gmp to 6.3.0.
The tarball format is now xz, and gmpsrc.patch has been patched into
the tarball so hadrian no longer needs to deal with patching logic
when building in-tree GMP.

- - - - -
65b4b92f by Cheng Shao at 2024-04-25T01:32:02-04:00
hadrian: remove obsolete Patch logic

This commit removes obsolete Patch logic from hadrian, given we no
longer need to patch the gmp tarball when building in-tree GMP.

- - - - -
71f28958 by Cheng Shao at 2024-04-25T01:32:02-04:00
autoconf: remove obsolete patch detection

This commit removes obsolete deletection logic of the patch command
from autoconf scripts, given we no longer need to patch anything in
the GHC build process.

- - - - -
daeda834 by Sylvain Henry at 2024-04-25T01:32:43-04:00
JS: correctly handle RUBBISH literals (#24664)

- - - - -
dc1664c8 by Andreas Klebinger at 2024-05-02T19:55:17+02:00
-fprof-late: Only insert cost centres on functions/non-workfree cafs.

They are usually useless and doing so for data values comes with
a large compile time/code size overhead.

Fixes #24103

- - - - -


17 changed files:

- compiler/GHC/Core.hs
- compiler/GHC/Core/LateCC.hs
- compiler/GHC/Core/LateCC/TopLevelBinds.hs
- compiler/GHC/Core/LateCC/Types.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/StgToJS/Literal.hs
- compiler/GHC/Types/RepType.hs
- configure.ac
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/profiling.rst
- hadrian/cfg/system.config.in
- hadrian/src/Builder.hs
- hadrian/src/Rules/Gmp.hs
- libraries/ghc-bignum/gmp/gmp-tarballs
- − libraries/ghc-bignum/gmp/gmpsrc.patch
- − libraries/ghc-bignum/gmp/ln


Changes:

=====================================
compiler/GHC/Core.hs
=====================================
@@ -94,7 +94,7 @@ module GHC.Core (
 import GHC.Prelude
 import GHC.Platform
 
-import GHC.Types.Var.Env( InScopeSet )
+import GHC.Types.Var.Env( InScopeSet, emptyInScopeSet )
 import GHC.Types.Var
 import GHC.Core.Type
 import GHC.Core.Coercion


=====================================
compiler/GHC/Core/LateCC.hs
=====================================
@@ -21,6 +21,7 @@ import GHC.Types.SrcLoc
 import GHC.Utils.Error
 import GHC.Utils.Logger
 import GHC.Utils.Outputable
+import GHC.Types.RepType (mightBeFunTy)
 
 -- | Late cost center insertion logic used by the driver
 addLateCostCenters ::
@@ -78,8 +79,11 @@ addLateCostCenters logger LateCCConfig{..} core_binds = do
     top_level_cc_pred :: CoreExpr -> Bool
     top_level_cc_pred =
         case lateCCConfig_whichBinds of
-          LateCCAllBinds ->
-            const True
+          LateCCBinds -> \rhs ->
+            -- Make sure we record any functions. Even if it's something like `f = g`.
+            mightBeFunTy (exprType rhs) ||
+            -- If the RHS is a CAF doing work also insert a CC.
+            not (exprIsWorkFree rhs)
           LateCCOverloadedBinds ->
             isOverloadedTy . exprType
           LateCCNone ->


=====================================
compiler/GHC/Core/LateCC/TopLevelBinds.hs
=====================================
@@ -3,16 +3,18 @@ module GHC.Core.LateCC.TopLevelBinds where
 
 import GHC.Prelude
 
-import GHC.Core
--- import GHC.Core.LateCC
 import GHC.Core.LateCC.Types
 import GHC.Core.LateCC.Utils
+
+import GHC.Core
 import GHC.Core.Opt.Monad
 import GHC.Driver.DynFlags
 import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Unit.Module.ModGuts
 
+import Data.Maybe
+
 {- Note [Collecting late cost centres]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Usually cost centres defined by a module are collected
@@ -89,15 +91,20 @@ topLevelBindsCC pred core_bind =
 
     doBndr :: Id -> CoreExpr -> LateCCM s CoreExpr
     doBndr bndr rhs
-      -- Cost centres on constructor workers are pretty much useless
-      -- so we don't emit them if we are looking at the rhs of a constructor
-      -- binding.
-      | Just _ <- isDataConId_maybe bndr = pure rhs
-      | otherwise = if pred rhs then addCC bndr rhs else pure rhs
+      -- Not a constructor worker.
+      -- Cost centres on constructor workers are pretty much useless so we don't emit them
+      -- if we are looking at the rhs of a constructor binding.
+      | isNothing (isDataConId_maybe bndr)
+      , pred rhs
+      = addCC bndr rhs
+      | otherwise = pure rhs
 
     -- We want to put the cost centre below the lambda as we only care about
-    -- executions of the RHS.
+    -- executions of the RHS. Note that the lambdas might be hidden under ticks
+    -- or casts. So look through these as well.
     addCC :: Id -> CoreExpr -> LateCCM s CoreExpr
+    addCC bndr (Cast rhs co) = pure Cast <*> addCC bndr rhs <*> pure co
+    addCC bndr (Tick t rhs) = (Tick t) <$> addCC bndr rhs
     addCC bndr (Lam b rhs) = Lam b <$> addCC bndr rhs
     addCC bndr rhs = do
       let name = idName bndr


=====================================
compiler/GHC/Core/LateCC/Types.hs
=====================================
@@ -34,7 +34,7 @@ data LateCCConfig =
 -- | The types of top-level bindings we support adding cost centers to.
 data LateCCBindSpec =
       LateCCNone
-    | LateCCAllBinds
+    | LateCCBinds
     | LateCCOverloadedBinds
 
 -- | Late cost centre insertion environment


=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -1954,6 +1954,8 @@ isPiTy ty = case coreFullView ty of
   _           -> False
 
 -- | Is this a function?
+-- Note: `forall {b}. Show b => b -> IO b` will not be considered a function by this function.
+--       It would merely be a forall wrapping a function type.
 isFunTy :: Type -> Bool
 isFunTy ty
   | FunTy {} <- coreFullView ty = True


=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1805,7 +1805,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do
                   if gopt Opt_ProfLateInlineCcs dflags then
                     LateCCNone
                   else if gopt Opt_ProfLateCcs dflags then
-                    LateCCAllBinds
+                    LateCCBinds
                   else if gopt Opt_ProfLateOverloadedCcs dflags then
                     LateCCOverloadedBinds
                   else


=====================================
compiler/GHC/StgToJS/Literal.hs
=====================================
@@ -22,6 +22,7 @@ import GHC.StgToJS.Symbols
 import GHC.Data.FastString
 import GHC.Types.Literal
 import GHC.Types.Basic
+import GHC.Types.RepType
 import GHC.Utils.Misc
 import GHC.Utils.Panic
 import GHC.Utils.Outputable
@@ -68,7 +69,27 @@ genLit = \case
     | otherwise              -> return [ toJExpr (global (mkRawSymbol True name))
                                        , ValExpr (JInt 0)
                                        ]
-  LitRubbish {} -> return [ null_ ]
+  LitRubbish _ rr_ty ->
+    -- Generate appropriate rubbish literals, otherwise it might trip up the
+    -- code generator when a primop is applied to a rubbish literal (see #24664)
+    let reps = runtimeRepPrimRep (text "GHC.StgToJS.Literal.genLit") rr_ty
+        rub  = \case
+                  BoxedRep _ -> [ null_ ]
+                  AddrRep    -> [ null_, ValExpr (JInt 0) ]
+                  WordRep    -> [ ValExpr (JInt 0) ]
+                  Word8Rep   -> [ ValExpr (JInt 0) ]
+                  Word16Rep  -> [ ValExpr (JInt 0) ]
+                  Word32Rep  -> [ ValExpr (JInt 0) ]
+                  Word64Rep  -> [ ValExpr (JInt 0), ValExpr (JInt 0) ]
+                  IntRep     -> [ ValExpr (JInt 0) ]
+                  Int8Rep    -> [ ValExpr (JInt 0) ]
+                  Int16Rep   -> [ ValExpr (JInt 0) ]
+                  Int32Rep   -> [ ValExpr (JInt 0) ]
+                  Int64Rep   -> [ ValExpr (JInt 0), ValExpr (JInt 0) ]
+                  DoubleRep  -> [ ValExpr (JInt 0) ]
+                  FloatRep   -> [ ValExpr (JInt 0) ]
+                  VecRep _ _ -> panic "GHC.StgToJS.Literal.genLit: VecRep unsupported"
+    in return (concatMap rub reps)
 
 -- | generate a literal for the static init tables
 genStaticLit :: Literal -> G [StaticLit]


=====================================
compiler/GHC/Types/RepType.hs
=====================================
@@ -693,6 +693,9 @@ mightBeFunTy :: Type -> Bool
 -- AK: It would be nice to figure out and document the difference
 -- between this and isFunTy at some point.
 mightBeFunTy ty
+  -- Currently ghc has no unlifted functions.
+  | definitelyUnliftedType ty
+  = False
   | [BoxedRep _] <- typePrimRep ty
   , Just tc <- tyConAppTyCon_maybe (unwrapType ty)
   , isDataTyCon tc


=====================================
configure.ac
=====================================
@@ -740,10 +740,6 @@ dnl ** check for tar
 dnl   if GNU tar is named gtar, look for it first.
 AC_PATH_PROGS(TarCmd,gnutar gtar tar,tar)
 
-dnl ** check for patch
-dnl if GNU patch is named gpatch, look for it first
-AC_PATH_PROGS(PatchCmd,gpatch patch, patch)
-
 dnl ** check for autoreconf
 AC_PATH_PROG(AutoreconfCmd, autoreconf, autoreconf)
 


=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -26,6 +26,16 @@ Language
 Compiler
 ~~~~~~~~
 
+- The flag `-fprof-late` will no longer prevent top level constructors from being statically allocated.
+
+  It used to be the case that we would add a cost centre for bindings like `foo = Just bar`.
+  This turned the binding into a caf that would allocate the constructor on first evaluation.
+
+  However without the cost centre `foo` can be allocated at compile time. This reduces code-bloat and
+  reduces overhead for short-running applications.
+
+  The tradeoff is that calling `whoCreated` on top level value definitions like `foo` will be less informative.
+
 
 GHCi
 ~~~~


=====================================
docs/users_guide/profiling.rst
=====================================
@@ -483,10 +483,12 @@ of your profiled program will be different to that of the unprofiled one.
 
     :since: 9.4.1
 
-    Adds an automatic ``SCC`` annotation to all top level bindings late in the compilation pipeline after
-    the optimizer has run and unfoldings have been created. This means these cost centres will not interfere with core-level optimizations
+    Adds an automatic ``SCC`` annotation to all top level bindings which might perform work.
+    This is done late in the compilation pipeline after the optimizer has run and unfoldings have been created.
+    This means these cost centres will not interfere with core-level optimizations
     and the resulting profile will be closer to the performance profile of an optimized non-profiled
     executable.
+
     While the results of this are generally informative, some of the compiler internal names
     will leak into the profile. Further if a function is inlined into a use site it's costs will be counted against the
     caller's cost center.


=====================================
hadrian/cfg/system.config.in
=====================================
@@ -17,7 +17,6 @@ sphinx-build   = @SPHINXBUILD@
 system-ghc     = @WithGhc@
 system-ghc-pkg = @GhcPkgCmd@
 tar            = @TarCmd@
-patch          = @PatchCmd@
 xelatex        = @XELATEX@
 makeindex      = @MAKEINDEX@
 makeinfo       = @MAKEINFO@


=====================================
hadrian/src/Builder.hs
=====================================
@@ -8,10 +8,7 @@ module Builder (
     -- * Builder properties
     builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilders,
     runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath,
-    builderEnvironment,
-
-    -- * Ad hoc builder invocation
-    applyPatch
+    builderEnvironment
     ) where
 
 import Control.Exception.Extra (Partial)
@@ -184,7 +181,6 @@ data Builder = Alex
              | MergeObjects Stage -- ^ linker to be used to merge object files.
              | Nm
              | Objdump
-             | Patch
              | Python
              | Ranlib
              | Testsuite TestMode
@@ -443,7 +439,6 @@ systemBuilderPath builder = case builder of
     Makeinfo        -> fromKey "makeinfo"
     Nm              -> fromTargetTC "nm" (Toolchain.nmProgram . tgtNm)
     Objdump         -> fromKey "objdump"
-    Patch           -> fromKey "patch"
     Python          -> fromKey "python"
     Ranlib          -> fromTargetTC "ranlib" (maybeProg Toolchain.ranlibProgram . tgtRanlib)
     Testsuite _     -> fromKey "python"
@@ -511,15 +506,6 @@ systemBuilderPath builder = case builder of
 isSpecified :: Builder -> Action Bool
 isSpecified = fmap (not . null) . systemBuilderPath
 
--- | Apply a patch by executing the 'Patch' builder in a given directory.
-applyPatch :: FilePath -> FilePath -> Action ()
-applyPatch dir patch = do
-    let file = dir -/- patch
-    needBuilders [Patch]
-    path <- builderPath Patch
-    putBuild $ "| Apply patch " ++ file
-    quietly $ cmd' [Cwd dir, FileStdin file] [path, "-p0"]
-
 -- Note [cmd wrapper]
 -- ~~~~~~~~~~~~~~~~~~
 -- `cmd'` is a wrapper for Shake's `cmd` that allows us to customize what is


=====================================
hadrian/src/Rules/Gmp.hs
=====================================
@@ -143,23 +143,18 @@ gmpRules = do
                 gmpP      = takeDirectory gmpBuildP
             ctx <- makeGmpPathContext gmpP
             removeDirectory gmpBuildP
-            -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
-            -- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
+            -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.xz, which is
+            -- gmp-4.2.4.tar.xz repacked without the doc/ directory contents.
             -- That's because the doc/ directory contents are under the GFDL,
             -- which causes problems for Debian.
             tarball <- unifyPath . fromSingleton "Exactly one GMP tarball is expected"
-                   <$> getDirectoryFiles top [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]
+                   <$> getDirectoryFiles top [gmpBase -/- "gmp-tarballs/gmp*.tar.xz"]
 
             withTempDir $ \dir -> do
                 let tmp = unifyPath dir
                 need [top -/- tarball]
                 build $ target ctx (Tar Extract) [top -/- tarball] [tmp]
 
-                let patch     = gmpBase -/- "gmpsrc.patch"
-                    patchName = takeFileName patch
-                copyFile patch $ tmp -/- patchName
-                applyPatch tmp patchName
-
                 let name    = dropExtension . dropExtension $ takeFileName tarball
                     unpack  = fromMaybe . error $ "gmpRules: expected suffix "
                         ++ "-nodoc (found: " ++ name ++ ")."


=====================================
libraries/ghc-bignum/gmp/gmp-tarballs
=====================================
@@ -1 +1 @@
-Subproject commit 4f26049af40afb380eaf033ab91404cd2e214919
+Subproject commit 01149ce3471128e9fe0feca607579981f4b64395


=====================================
libraries/ghc-bignum/gmp/gmpsrc.patch deleted
=====================================
@@ -1,44 +0,0 @@
-diff -Naur gmp-6.2.1/Makefile.am gmpbuild/Makefile.am
---- gmp-6.2.1/Makefile.am	2020-11-15 02:45:09.000000000 +0800
-+++ gmpbuild/Makefile.am	2021-01-09 22:56:14.571708858 +0800
-@@ -112,7 +112,7 @@
- LIBGMPXX_LT_AGE      = 6
- 
- 
--SUBDIRS = tests mpn mpz mpq mpf printf scanf rand cxx demos tune doc
-+SUBDIRS = tests mpn mpz mpq mpf printf scanf rand cxx demos tune
- 
- EXTRA_DIST = configfsf.guess configfsf.sub .gdbinit INSTALL.autoconf \
- 	     COPYING.LESSERv3 COPYINGv2 COPYINGv3
-diff -Naur gmp-6.2.1/Makefile.in gmpbuild/Makefile.in
---- gmp-6.2.1/Makefile.in	2020-11-15 02:45:16.000000000 +0800
-+++ gmpbuild/Makefile.in	2021-01-10 16:15:37.387670402 +0800
-@@ -572,7 +572,7 @@
- LIBGMPXX_LT_CURRENT = 10
- LIBGMPXX_LT_REVISION = 1
- LIBGMPXX_LT_AGE = 6
--SUBDIRS = tests mpn mpz mpq mpf printf scanf rand cxx demos tune doc
-+SUBDIRS = tests mpn mpz mpq mpf printf scanf rand cxx demos tune
- 
- # Put asl.h here for now.
- 
-diff -Naur gmp-6.2.1/configure gmpbuild/configure
---- gmp-6.2.1/configure	2020-11-15 02:45:15.000000000 +0800
-+++ gmpbuild/configure	2021-01-10 16:13:59.196004951 +0800
-@@ -27985,7 +27985,7 @@
- # FIXME: Upcoming version of autoconf/automake may not like broken lines.
- #        Right now automake isn't accepting the new AC_CONFIG_FILES scheme.
- 
--ac_config_files="$ac_config_files Makefile mpf/Makefile mpn/Makefile mpq/Makefile mpz/Makefile printf/Makefile scanf/Makefile rand/Makefile cxx/Makefile tests/Makefile tests/devel/Makefile tests/mpf/Makefile tests/mpn/Makefile tests/mpq/Makefile tests/mpz/Makefile tests/rand/Makefile tests/misc/Makefile tests/cxx/Makefile doc/Makefile tune/Makefile demos/Makefile demos/calc/Makefile demos/expr/Makefile gmp.h:gmp-h.in gmp.pc:gmp.pc.in gmpxx.pc:gmpxx.pc.in"
-+ac_config_files="$ac_config_files Makefile mpf/Makefile mpn/Makefile mpq/Makefile mpz/Makefile printf/Makefile scanf/Makefile rand/Makefile cxx/Makefile tests/Makefile tests/devel/Makefile tests/mpf/Makefile tests/mpn/Makefile tests/mpq/Makefile tests/mpz/Makefile tests/rand/Makefile tests/misc/Makefile tests/cxx/Makefile tune/Makefile demos/Makefile demos/calc/Makefile demos/expr/Makefile gmp.h:gmp-h.in gmp.pc:gmp.pc.in gmpxx.pc:gmpxx.pc.in"
- 
- cat >confcache <<\_ACEOF
- # This file is a shell script that caches the results of configure
-@@ -29129,7 +29129,6 @@
-     "tests/rand/Makefile") CONFIG_FILES="$CONFIG_FILES tests/rand/Makefile" ;;
-     "tests/misc/Makefile") CONFIG_FILES="$CONFIG_FILES tests/misc/Makefile" ;;
-     "tests/cxx/Makefile") CONFIG_FILES="$CONFIG_FILES tests/cxx/Makefile" ;;
--    "doc/Makefile") CONFIG_FILES="$CONFIG_FILES doc/Makefile" ;;
-     "tune/Makefile") CONFIG_FILES="$CONFIG_FILES tune/Makefile" ;;
-     "demos/Makefile") CONFIG_FILES="$CONFIG_FILES demos/Makefile" ;;
-     "demos/calc/Makefile") CONFIG_FILES="$CONFIG_FILES demos/calc/Makefile" ;;


=====================================
libraries/ghc-bignum/gmp/ln deleted
=====================================
@@ -1,3 +0,0 @@
-#!/bin/sh
-exit 1
-



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5171a4e4abb06730367b47834761be9bf830d761...dc1664c88cee8bddbcee911ea991492e7d19ed31

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5171a4e4abb06730367b47834761be9bf830d761...dc1664c88cee8bddbcee911ea991492e7d19ed31
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/20240502/8d963ef7/attachment-0001.html>


More information about the ghc-commits mailing list