[Git][ghc/ghc][wip/24107] 13 commits: docs(NonEmpty/group): Remove incorrect haddock link quotes in code block

Zubin (@wz1000) gitlab at gitlab.haskell.org
Wed Dec 6 07:51:22 UTC 2023



Zubin pushed to branch wip/24107 at Glasgow Haskell Compiler / GHC


Commits:
010fb784 by Owen Shepherd at 2023-12-03T00:10:09-05:00
docs(NonEmpty/group): Remove incorrect haddock link quotes in code block

- - - - -
cda9c12d by Owen Shepherd at 2023-12-03T00:10:09-05:00
docs(NonEmpty/group): Remove cycle from group haddock example

- - - - -
495265b9 by Owen Shepherd at 2023-12-03T00:10:09-05:00
docs(NonEmpty/group): Use repl haddock syntax in group docs

- - - - -
d134d1de by Owen Shepherd at 2023-12-03T00:10:09-05:00
docs(NonEmpty/group): Use list [] notation in group haddock

- - - - -
dfcf629c by Owen Shepherd at 2023-12-03T00:10:10-05:00
docs(NonEmpty/group): Specify final property of group function in haddock

- - - - -
cad3b734 by Owen Shepherd at 2023-12-03T00:10:10-05:00
fix: Add missing property of List.group

- - - - -
bad37656 by Matthew Pickering at 2023-12-03T00:10:46-05:00
testsuite: Fix T21097b test with make 4.1 (deb9)

cee81370cd6ef256f66035e3116878d4cb82e28b recently added a test which
failed on deb9 because the version of make was emitting the recipe
failure to stdout rather than stderr.

One way to fix this is to be more precise in the test about which part
of the output we care about inspecting.

- - - - -
5efdf421 by Matthew Pickering at 2023-12-03T00:11:21-05:00
testsuite: Track size of libdir in bytes

For consistency it's better if we track all size metrics in bytes.

Metric Increase:
  libdir

- - - - -
f5eb0f29 by Matthew Pickering at 2023-12-03T00:11:22-05:00
testsuite: Remove rogue trace in testsuite

I accidentally left a trace in the generics metric patch.

- - - - -
dae9954a by Zubin Duggal at 2023-12-06T13:21:07+05:30
driver: Ensure we actually clear the interactive context before reloading

Previously we called discardIC, but immediately after set the session
back to an old HscEnv that still contained the IC

Partially addresses #24107
Fixes #23405

- - - - -
c81501c1 by Zubin Duggal at 2023-12-06T13:21:07+05:30
driver: Ensure we force the lookup of old build artifacts before returning the build plan

This prevents us from retaining all previous build artifacts in memory until a
recompile finishes, instead only retaining the exact artifacts we need.

Fixes #24118

- - - - -
acd231c1 by Zubin Duggal at 2023-12-06T13:21:07+05:30
testsuite: add test for #24118 and #24107

MultiLayerModulesDefsGhci was not able to catch the leak because it uses
:l which discards the previous environment.

Using :r catches both of these leaks

- - - - -
58837bfa by Zubin Duggal at 2023-12-06T13:21:07+05:30
compiler: Add some strictness annotations to ImportSpec and related constructors
This prevents us from retaining entire HscEnvs.

Force these ImportSpecs when forcing the GlobalRdrEltX

Adds an NFData instance for Bag

Fixes #24107

- - - - -


15 changed files:

- compiler/GHC/Data/Bag.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Types/Name/Reader.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/base/src/Data/OldList.hs
- testsuite/driver/testlib.py
- testsuite/tests/driver/T21097b/T21097b.stdout
- testsuite/tests/driver/T21097b/all.T
- + testsuite/tests/ghci/T23405/T23405.hs
- + testsuite/tests/ghci/T23405/T23405.script
- + testsuite/tests/ghci/T23405/all.T
- + testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciReload.script
- testsuite/tests/perf/compiler/all.T
- − testsuite/tests/perf/size/Makefile
- testsuite/tests/perf/size/all.T


Changes:

=====================================
compiler/GHC/Data/Bag.hs
=====================================
@@ -40,6 +40,7 @@ import Data.List.NonEmpty ( NonEmpty(..) )
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Semigroup ( (<>) )
 import Control.Applicative( Alternative( (<|>) ) )
+import Control.DeepSeq
 
 infixr 3 `consBag`
 infixl 3 `snocBag`
@@ -51,6 +52,12 @@ data Bag a
   | ListBag (NonEmpty a)
   deriving (Foldable, Functor, Traversable)
 
+instance NFData a => NFData (Bag a) where
+  rnf EmptyBag = ()
+  rnf (UnitBag a) = rnf a
+  rnf (TwoBags a b) = rnf a `seq` rnf b
+  rnf (ListBag a) = rnf a
+
 emptyBag :: Bag a
 emptyBag = EmptyBag
 


=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -771,6 +771,7 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do
 
     let pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable }
     setSession $ discardIC $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env
+    hsc_env <- getSession
 
     -- Unload everything
     liftIO $ unload interp hsc_env
@@ -780,7 +781,6 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do
 
     worker_limit <- liftIO $ mkWorkerLimit dflags
 
-    setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env
     (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do
       hsc_env <- getSession
       liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan
@@ -1145,33 +1145,37 @@ interpretBuildPlan hug mhmi_cache old_hpt plan = do
           -- which would retain all the result variables, preventing us from collecting them
           -- after they are no longer used.
           !build_deps = getDependencies direct_deps build_map
-      let build_action =
-            withCurrentUnit (moduleGraphNodeUnitId mod) $ do
-            (hug, deps) <- wait_deps_hug hug_var build_deps
+      let !build_action =
             case mod of
               InstantiationNode uid iu -> do
-                executeInstantiationNode mod_idx n_mods hug uid iu
-                return (Nothing, deps)
-              ModuleNode _build_deps ms -> do
+                withCurrentUnit (moduleGraphNodeUnitId mod) $ do
+                  (hug, deps) <- wait_deps_hug hug_var build_deps
+                  executeInstantiationNode mod_idx n_mods hug uid iu
+                  return (Nothing, deps)
+              ModuleNode _build_deps ms ->
                 let !old_hmi = M.lookup (msKey ms) old_hpt
                     rehydrate_mods = mapMaybe nodeKeyModName <$> rehydrate_nodes
-                hmi <- executeCompileNode mod_idx n_mods old_hmi hug rehydrate_mods ms
-                -- Write the HMI to an external cache (if one exists)
-                -- See Note [Caching HomeModInfo]
-                liftIO $ forM mhmi_cache $ \hmi_cache -> addHmiToCache hmi_cache hmi
-                -- This global MVar is incrementally modified in order to avoid having to
-                -- recreate the HPT before compiling each module which leads to a quadratic amount of work.
-                liftIO $ modifyMVar_ hug_var (return . addHomeModInfoToHug hmi)
-                return (Just hmi, addToModuleNameSet (moduleGraphNodeUnitId mod) (ms_mod_name ms) deps )
+                in withCurrentUnit (moduleGraphNodeUnitId mod) $ do
+                     (hug, deps) <- wait_deps_hug hug_var build_deps
+                     hmi <- executeCompileNode mod_idx n_mods old_hmi hug rehydrate_mods ms
+                     -- Write the HMI to an external cache (if one exists)
+                     -- See Note [Caching HomeModInfo]
+                     liftIO $ forM mhmi_cache $ \hmi_cache -> addHmiToCache hmi_cache hmi
+                     -- This global MVar is incrementally modified in order to avoid having to
+                     -- recreate the HPT before compiling each module which leads to a quadratic amount of work.
+                     liftIO $ modifyMVar_ hug_var (return . addHomeModInfoToHug hmi)
+                     return (Just hmi, addToModuleNameSet (moduleGraphNodeUnitId mod) (ms_mod_name ms) deps )
               LinkNode _nks uid -> do
-                  executeLinkNode hug (mod_idx, n_mods) uid direct_deps
-                  return (Nothing, deps)
+                  withCurrentUnit (moduleGraphNodeUnitId mod) $ do
+                    (hug, deps) <- wait_deps_hug hug_var build_deps
+                    executeLinkNode hug (mod_idx, n_mods) uid direct_deps
+                    return (Nothing, deps)
 
 
       res_var <- liftIO newEmptyMVar
       let result_var = mkResultVar res_var
       setModulePipeline (mkNodeKey mod) (mkBuildResult origin result_var)
-      return $ (MakeAction build_action res_var)
+      return $! (MakeAction build_action res_var)
 
 
     buildOneLoopyModule :: ModuleGraphNodeWithBootFile -> BuildM [MakeAction]
@@ -2986,7 +2990,7 @@ runLoop fork_thread env (MakeAction act res_var :acts) = do
       run_pipeline :: RunMakeM a -> IO (Maybe a)
       run_pipeline p = runMaybeT (runReaderT p env)
 
-data MakeAction = forall a . MakeAction (RunMakeM a) (MVar (Maybe a))
+data MakeAction = forall a . MakeAction !(RunMakeM a) !(MVar (Maybe a))
 
 waitMakeAction :: MakeAction -> IO ()
 waitMakeAction (MakeAction _ mvar) = () <$ readMVar mvar


=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -934,11 +934,11 @@ globalRdrEnvElts env = nonDetFoldOccEnv (++) [] env
 
 -- | Drop all 'GREInfo' fields in a 'GlobalRdrEnv' in order to
 -- avoid space leaks.
---
+-- Also forces the bag in gre_imp.
 -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
 forceGlobalRdrEnv :: GlobalRdrEnvX info -> IfGlobalRdrEnv
 forceGlobalRdrEnv rdrs =
-  strictMapOccEnv (strictMap (\ gre -> gre { gre_info = () })) rdrs
+  strictMapOccEnv (strictMap (\ gre -> rnf (gre_imp gre) `seq` gre { gre_info = ()})) rdrs
 
 -- | Hydrate a previously dehydrated 'GlobalRdrEnv',
 -- by (lazily!) looking up the 'GREInfo' using the provided function.
@@ -1916,25 +1916,28 @@ instance Semigroup ShadowedGREs where
 --
 -- The 'ImportSpec' of something says how it came to be imported
 -- It's quite elaborate so that we can give accurate unused-name warnings.
-data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
-                            is_item :: ImpItemSpec }
+data ImportSpec = ImpSpec { is_decl :: !ImpDeclSpec,
+                            is_item :: !ImpItemSpec }
                 deriving( Eq, Data )
 
+instance NFData ImportSpec where
+  rnf = rwhnf -- All fields are strict, so we don't need to do anything
+
 -- | Import Declaration Specification
 --
 -- Describes a particular import declaration and is
 -- shared among all the 'Provenance's for that decl
 data ImpDeclSpec
   = ImpDeclSpec {
-        is_mod      :: Module,     -- ^ Module imported, e.g. @import Muggle@
+        is_mod      :: !Module,     -- ^ Module imported, e.g. @import Muggle@
                                    -- Note the @Muggle@ may well not be
                                    -- the defining module for this thing!
 
                                    -- TODO: either should be Module, or there
                                    -- should be a Maybe UnitId here too.
-        is_as       :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
-        is_qual     :: Bool,       -- ^ Was this import qualified?
-        is_dloc     :: SrcSpan     -- ^ The location of the entire import declaration
+        is_as       :: !ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
+        is_qual     :: !Bool,       -- ^ Was this import qualified?
+        is_dloc     :: !SrcSpan     -- ^ The location of the entire import declaration
     } deriving (Eq, Data)
 
 -- | Import Item Specification
@@ -1945,8 +1948,8 @@ data ImpItemSpec
                         -- or had a hiding list
 
   | ImpSome {
-        is_explicit :: Bool,
-        is_iloc     :: SrcSpan  -- Location of the import item
+        is_explicit :: !Bool,
+        is_iloc     :: !SrcSpan  -- Location of the import item
     }   -- ^ The import had an import list.
         -- The 'is_explicit' field is @True@ iff the thing was named
         -- /explicitly/ in the import specs rather


=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -398,10 +398,12 @@ partition p = List.partition p . toList
 -- | The 'group' function takes a stream and returns a list of
 -- streams such that flattening the resulting list is equal to the
 -- argument.  Moreover, each stream in the resulting list
--- contains only equal elements.  For example, in list notation:
+-- contains only equal elements, and consecutive equal elements
+-- of the input end up in the same stream of the output list.
+-- For example, in list notation:
 --
--- > 'group' $ 'cycle' "Mississippi"
--- >   = "M" : "i" : "ss" : "i" : "ss" : "i" : "pp" : "i" : "M" : "i" : ...
+-- >>> group "Mississippi"
+-- ["M", "i", "ss", "i", "ss", "i", "pp", "i"]
 group :: (Foldable f, Eq a) => f a -> [NonEmpty a]
 group = groupBy (==)
 


=====================================
libraries/base/src/Data/OldList.hs
=====================================
@@ -1360,8 +1360,9 @@ deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
 
 -- | The 'group' function takes a list and returns a list of lists such
 -- that the concatenation of the result is equal to the argument.  Moreover,
--- each sublist in the result is non-empty and all elements are equal
--- to the first one.
+-- each sublist in the result is non-empty, all elements are equal to the
+-- first one, and consecutive equal elements of the input end up in the
+-- same element of the output list.
 --
 -- 'group' is a special case of 'groupBy', which allows the programmer to supply
 -- their own equality test.


=====================================
testsuite/driver/testlib.py
=====================================
@@ -607,6 +607,19 @@ def _extra_files(name, opts, files):
 def collect_size ( deviation, path ):
     return collect_generic_stat ( 'size', deviation, lambda way: os.path.getsize(in_testdir(path)) )
 
+def get_dir_size(path):
+    total = 0
+    with os.scandir(path) as it:
+        for entry in it:
+            if entry.is_file():
+                total += entry.stat().st_size
+            elif entry.is_dir():
+                total += get_dir_size(entry.path)
+    return total
+
+def collect_size_dir ( deviation, path ):
+    return collect_generic_stat ( 'size', deviation, lambda way: get_dir_size(path) )
+
 # Read a number from a specific file
 def stat_from_file ( metric, deviation, path ):
     def read_file (way):
@@ -1810,7 +1823,6 @@ def metric_dict(name, way, metric, value) -> PerfStat:
 def check_generic_stats(name, way, get_stats):
     for (metric, gen_stat) in get_stats.items():
         res = report_stats(name, way, metric, gen_stat)
-        print(res)
         if badResult(res):
             return res
     return passed()


=====================================
testsuite/tests/driver/T21097b/T21097b.stdout
=====================================
@@ -1,5 +1 @@
-
-==================== Module Map ====================
 Foo                                               a-0.1 (exposed package)
-
-


=====================================
testsuite/tests/driver/T21097b/all.T
=====================================
@@ -1,6 +1,15 @@
+def normalise_t21097b_output(s):
+  res = ""
+  for l in s.splitlines():
+    if 'Foo' in l:
+      res += l
+      res += "\n"
+  return res
+
 # Package b is unusable (broken dependency) and reexport Foo from a (which is usable)
 test('T21097b',
   [ extra_files(["pkgdb", "pkgdb/a.conf", "pkgdb/b.conf", "Test.hs"])
   , ignore_stderr
+  , normalise_fun(normalise_t21097b_output)
   , exit_code(2)
   ], makefile_test, [])


=====================================
testsuite/tests/ghci/T23405/T23405.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T23405 (test) where
+
+import Language.Haskell.TH
+
+test :: IO ()
+test = do
+  let s = $(getDoc (DeclDoc ''Double) >>= \doc -> [|doc|])
+  print (s `seq` ())
+
+


=====================================
testsuite/tests/ghci/T23405/T23405.script
=====================================
@@ -0,0 +1,3 @@
+:load T23405.hs
+:! echo "-- an extra comment so that the hash changes" >> T18262.hs
+:reload


=====================================
testsuite/tests/ghci/T23405/all.T
=====================================
@@ -0,0 +1 @@
+test('T23405', [extra_files(['T23405.hs'])], ghci_script, ['T23405.script'])


=====================================
testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciReload.script
=====================================
@@ -0,0 +1,4 @@
+:set -fforce-recomp
+:l MultiLayerModules.hs
+:r
+:r


=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -391,6 +391,19 @@ test('MultiLayerModulesDefsGhci',
      ghci_script,
      ['MultiLayerModulesDefsGhci.script'])
 
+test('MultiLayerModulesDefsGhciReload',
+     [ collect_compiler_residency(15),
+       pre_cmd('./genMultiLayerModulesDefs'),
+       extra_files(['genMultiLayerModulesDefs']),
+       compile_timeout_multiplier(5)
+       # this is _a lot_
+       # but this test has been failing every now and then,
+       # especially on i386. Let's just give it some room
+       # to complete successfully reliably everywhere.
+     ],
+     ghci_script,
+     ['MultiLayerModulesDefsGhciReload.script'])
+
 test('InstanceMatching',
      [ collect_compiler_stats('bytes allocated',3),
        pre_cmd('$MAKE -s --no-print-directory InstanceMatching'),


=====================================
testsuite/tests/perf/size/Makefile deleted
=====================================
@@ -1,7 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
-
-libdir_size:
-	du -s `$(TEST_HC) --print-libdir` | cut -f1 > SIZE
-


=====================================
testsuite/tests/perf/size/all.T
=====================================
@@ -1,3 +1,3 @@
 test('size_hello_obj', [collect_size(5, 'size_hello_obj.o')], compile, [''])
 
-test('libdir',[stat_from_file('size', 10, 'SIZE')], makefile_test, ['libdir_size'] )
+test('libdir',[collect_size_dir(10, config.libdir)], static_stats, [] )



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42c4620d9df1eaceb4b8ebeeba8a5fa22f44f254...58837bfac616b913ed45f5402d2ad9e90cdada65

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42c4620d9df1eaceb4b8ebeeba8a5fa22f44f254...58837bfac616b913ed45f5402d2ad9e90cdada65
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/20231206/ac4c31a3/attachment-0001.html>


More information about the ghc-commits mailing list