[Git][ghc/ghc][master] 2 commits: refactor quadratic search in warnMissingHomeModules

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu May 16 03:09:03 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
bc672166 by Torsten Schmits at 2024-05-15T23:08:06-04:00
refactor quadratic search in warnMissingHomeModules

- - - - -
7875e8cb by Torsten Schmits at 2024-05-15T23:08:06-04:00
add test that runs MakeDepend on thousands of modules

- - - - -


4 changed files:

- compiler/GHC/Driver/Make.hs
- testsuite/driver/testlib.py
- + testsuite/tests/perf/compiler/large-project/all.T
- + testsuite/tests/perf/compiler/large-project/large-project.sh


Changes:

=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -299,16 +299,16 @@ linkNodes summaries uid hue =
 
 -- Note [Missing home modules]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- Sometimes user doesn't want GHC to pick up modules, not explicitly listed
--- in a command line. For example, cabal may want to enable this warning
--- when building a library, so that GHC warns user about modules, not listed
--- neither in `exposed-modules`, nor in `other-modules`.
+-- Sometimes we don't want GHC to process modules that weren't specified as
+-- explicit targets. For example, cabal may want to enable this warning
+-- when building a library, so that GHC warns the user about modules listed
+-- neither in `exposed-modules` nor in `other-modules`.
 --
--- Here "home module" means a module, that doesn't come from an other package.
+-- Here "home module" means a module that doesn't come from another package.
 --
 -- For example, if GHC is invoked with modules "A" and "B" as targets,
 -- but "A" imports some other module "C", then GHC will issue a warning
--- about module "C" not being listed in a command line.
+-- about module "C" not being listed in the command line.
 --
 -- The warning in enabled by `-Wmissing-home-modules`. See #13129
 warnMissingHomeModules ::  DynFlags -> [Target] -> ModuleGraph -> DriverMessages
@@ -319,8 +319,6 @@ warnMissingHomeModules dflags targets mod_graph =
   where
     diag_opts = initDiagOpts dflags
 
-    is_known_module mod = any (is_my_target mod) targets
-
     -- We need to be careful to handle the case where (possibly
     -- path-qualified) filenames (aka 'TargetFile') rather than module
     -- names are being passed on the GHC command-line.
@@ -329,27 +327,29 @@ warnMissingHomeModules dflags targets mod_graph =
     -- `ghc --make -isrc-exe Main` are supposed to be equivalent.
     -- Note also that we can't always infer the associated module name
     -- directly from the filename argument.  See #13727.
-    is_my_target mod target =
-      let tuid = targetUnitId target
-      in case targetId target of
-          TargetModule name
-            -> moduleName (ms_mod mod) == name
-                && tuid == ms_unitid mod
-          TargetFile target_file _
-            | Just mod_file <- ml_hs_file (ms_location mod)
-            ->
-             augmentByWorkingDirectory dflags target_file == mod_file ||
-
-             --  Don't warn on B.hs-boot if B.hs is specified (#16551)
-             addBootSuffix target_file == mod_file ||
-
-             --  We can get a file target even if a module name was
-             --  originally specified in a command line because it can
-             --  be converted in guessTarget (by appending .hs/.lhs).
-             --  So let's convert it back and compare with module name
-             mkModuleName (fst $ splitExtension target_file)
-              == moduleName (ms_mod mod)
-          _ -> False
+    is_known_module mod =
+      (Map.lookup (moduleName (ms_mod mod)) mod_targets == Just (ms_unitid mod))
+      ||
+      maybe False is_file_target (ml_hs_file (ms_location mod))
+
+    is_file_target file = Set.member (withoutExt file) file_targets
+
+    file_targets = Set.fromList (mapMaybe file_target targets)
+
+    file_target Target {targetId} =
+      case targetId of
+        TargetModule _ -> Nothing
+        TargetFile file _ ->
+          Just (withoutExt (augmentByWorkingDirectory dflags file))
+
+    mod_targets = Map.fromList (mod_target <$> targets)
+
+    mod_target Target {targetUnitId, targetId} =
+      case targetId of
+        TargetModule name -> (name, targetUnitId)
+        TargetFile file _ -> (mkModuleName (withoutExt file), targetUnitId)
+
+    withoutExt = fst . splitExtension
 
     missing = map (moduleName . ms_mod) $
       filter (not . is_known_module) $


=====================================
testsuite/driver/testlib.py
=====================================
@@ -748,7 +748,7 @@ def find_so(lib):
 def find_non_inplace_so(lib):
     return _find_so(lib,path_from_ghcPkg(lib, "dynamic-library-dirs"),False)
 
-# Define the a generic stat test, which computes the statistic by calling the function
+# Define a generic stat test, which computes the statistic by calling the function
 # given as the third argument.
 def collect_generic_stat ( metric, deviation, get_stat ):
     return collect_generic_stats ( { metric: { 'deviation': deviation, 'current': get_stat } } )
@@ -1766,6 +1766,9 @@ async def multi_compile( name, way, top_mod, extra_mods, extra_hc_opts ):
 async def multi_compile_fail( name, way, top_mod, extra_mods, extra_hc_opts ):
     return await do_compile( name, way, True, top_mod, extra_mods, [], extra_hc_opts)
 
+async def make_depend( name, way, mods, extra_hc_opts ):
+    return await do_compile( name, way, False,  ' '.join(mods), [], [], extra_hc_opts, mode = '-M')
+
 async def do_compile(name: TestName,
                way: WayName,
                should_fail: bool,
@@ -2044,7 +2047,9 @@ async def simple_build(name: Union[TestName, str],
                  addsuf: bool,
                  backpack: bool = False,
                  suppress_stdout: bool = False,
-                 filter_with: str = '') -> Any:
+                 filter_with: str = '',
+                 # Override auto-detection of whether to use --make or -c etc.
+                 mode: Optional[str] = None) -> Any:
     opts = getTestOpts()
 
     # Redirect stdout and stderr to the same file
@@ -2061,7 +2066,9 @@ async def simple_build(name: Union[TestName, str],
     else:
         srcname = Path(name)
 
-    if top_mod is not None:
+    if mode is not None:
+        to_do = mode
+    elif top_mod is not None:
         to_do = '--make '
         if link:
             to_do = to_do + '-o ' + name


=====================================
testsuite/tests/perf/compiler/large-project/all.T
=====================================
@@ -0,0 +1,21 @@
+# These tests are supposed to prevent severe performance regressions when
+# operating on projects with unusually large numbers of modules.
+# Inefficient algorithms whose complexity depends on the number of modules won't
+# be noticed when running the test suite or compiling medium size projects.
+
+def large_project_makedepend(num):
+    return test(
+        f'large-project-makedepend-{num}',
+        [
+            collect_compiler_stats('bytes allocated', 1),
+            pre_cmd(f'./large-project.sh {num}'),
+            extra_files(['large-project.sh']),
+            ignore_stderr,
+            windows_skip,
+        ],
+        make_depend,
+        [[f'Mod{i:04d}' for i in range(0, num - 1)], ''],
+        )
+
+large_project_makedepend(4000)
+large_project_makedepend(10000)


=====================================
testsuite/tests/perf/compiler/large-project/large-project.sh
=====================================
@@ -0,0 +1,22 @@
+#!/usr/bin/env bash
+
+set -eu
+
+total="$1"
+
+for ((i = 1; i < $total; i++))
+do
+  # Important to write directly to variables with `-v`, otherwise the script takes a second per 1000 modules
+  printf -v j "%04d" "$i"
+  printf -v k "%04d" "$(($i - 1))"
+  echo -e "module Mod${j} where
+import Mod${k}
+f_${j} :: ()
+f_${j} = f_$k" > "Mod${j}.hs"
+done
+
+echo "
+module Mod0000 where
+f_0000 :: ()
+f_0000 = ()
+" > "Mod0000.hs"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c7ae2a1c1adcc8267db2c0c5910ffbd6e3394a7...7875e8cbe5d9b69a1a77354317b2bf9478172686

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c7ae2a1c1adcc8267db2c0c5910ffbd6e3394a7...7875e8cbe5d9b69a1a77354317b2bf9478172686
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/20240515/68822e0e/attachment-0001.html>


More information about the ghc-commits mailing list