[Git][ghc/ghc][wip/testsuite-generic-stats] 6 commits: Properly compute unpacked sizes for -funpack-small-strict-fields.

Matthew Pickering (@mpickering) gitlab at gitlab.haskell.org
Fri Nov 17 12:36:22 UTC 2023



Matthew Pickering pushed to branch wip/testsuite-generic-stats at Glasgow Haskell Compiler / GHC


Commits:
49f5264b by Andreas Klebinger at 2023-11-16T20:52:11-05:00
Properly compute unpacked sizes for -funpack-small-strict-fields.

Use rep size rather than rep count to compute the size.

Fixes #22309

- - - - -
b4f84e4b by James Henri Haydon at 2023-11-16T20:52:53-05:00
Explicit methods for Alternative Compose

Explicitly define some and many in Alternative instance for
Data.Functor.Compose

Implementation of https://github.com/haskell/core-libraries-committee/issues/181

- - - - -
9bc0dd1f by Ignat Insarov at 2023-11-16T20:53:34-05:00
Add permutations for non-empty lists.

Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/68#issuecomment-1221409837

- - - - -
5643ecf9 by Andrew Lelechenko at 2023-11-16T20:53:34-05:00
Update changelog and since annotations for Data.List.NonEmpty.permutations

Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/68#issuecomment-1221409837

- - - - -
94ff2134 by Oleg Alexander at 2023-11-16T20:54:15-05:00
Update doc string for traceShow

Updated doc string for traceShow.

- - - - -
94021d18 by Matthew Pickering at 2023-11-17T12:36:03+00:00
testsuite: Add mechanism to collect generic metrics

* Generalise the metric logic by adding an additional field which
  allows you to specify how to query for the actual value. Previously
  the method of querying the baseline value was abstracted (but always
  set to the same thing).

* This requires rejigging how the stat collection works slightly but now
  it's more uniform and hopefully simpler.

* Introduce some new "generic" helper functions for writing generic
  stats tests.

  - collect_size ( deviation, path )
    Record the size of the file as a metric

  - stat_from_file ( metric, deviation, path )
    Read a value from the given path, and store that as a metric

  - collect_generic_stat ( metric, deviation, get_stat )
    Provide your own `get_stat` function, `lambda way: <Int>`, which
    can be used to establish the value of the metric.

  - collect_generic_stats ( get_stats ):
    Like collect_generic_stat but provide the whole dictionary of metric
    definitions.

    { metric: {
        deviation: <Int>
        action: lambda way: <Int>
        } }

* Introduce two new "size" metrics for keeping track of build products.
    - `size_hello` - The size of `hello.o` from compiling hello.hs
    - `libdir` - The total size of the `libdir` folder.

* Track the number of modules in the AST tests
   - CountDepsAst
   - CountDepsParser

This lays the infrastructure for #24191 #22256 #17129

- - - - -


23 changed files:

- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Types/Id/Make.hs
- docs/users_guide/9.10.1-notes.rst
- docs/users_guide/using-optimisation.rst
- libraries/base/changelog.md
- libraries/base/src/Data/Functor/Compose.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/base/src/Debug/Trace.hs
- testsuite/driver/perf_notes.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/count-deps/Makefile
- testsuite/tests/count-deps/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- + testsuite/tests/perf/size/Makefile
- + testsuite/tests/perf/size/all.T
- + testsuite/tests/perf/size/size_hello.hs
- + testsuite/tests/simplCore/should_compile/T22309.hs
- + testsuite/tests/simplCore/should_compile/T22309.stderr
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -128,8 +128,8 @@ module GHC.Core.TyCon(
         PrimRep(..), PrimElemRep(..), Levity(..),
         primElemRepToPrimRep,
         isVoidRep, isGcPtrRep,
-        primRepSizeB,
-        primElemRepSizeB,
+        primRepSizeB, primRepSizeW64_B,
+        primElemRepSizeB, primElemRepSizeW64_B,
         primRepIsFloat,
         primRepsCompatible,
         primRepCompatible,
@@ -1679,9 +1679,39 @@ primRepSizeB platform = \case
    VoidRep          -> 0
    (VecRep len rep) -> len * primElemRepSizeB platform rep
 
+-- | Like primRepSizeB but assumes pointers/words are 8 words wide.
+--
+-- This can be useful to compute the size of a rep as if we were compiling
+-- for a 64bit platform.
+primRepSizeW64_B :: PrimRep -> Int
+primRepSizeW64_B = \case
+   IntRep           -> 8
+   WordRep          -> 8
+   Int8Rep          -> 1
+   Int16Rep         -> 2
+   Int32Rep         -> 4
+   Int64Rep         -> 8
+   Word8Rep         -> 1
+   Word16Rep        -> 2
+   Word32Rep        -> 4
+   Word64Rep        -> 8
+   FloatRep         -> fLOAT_SIZE
+   DoubleRep        -> dOUBLE_SIZE
+   AddrRep          -> 8
+   BoxedRep{}       -> 8
+   VoidRep          -> 0
+   (VecRep len rep) -> len * primElemRepSizeW64_B rep
+
 primElemRepSizeB :: Platform -> PrimElemRep -> Int
 primElemRepSizeB platform = primRepSizeB platform . primElemRepToPrimRep
 
+-- | Like primElemRepSizeB but assumes pointers/words are 8 words wide.
+--
+-- This can be useful to compute the size of a rep as if we were compiling
+-- for a 64bit platform.
+primElemRepSizeW64_B :: PrimElemRep -> Int
+primElemRepSizeW64_B = primRepSizeW64_B . primElemRepToPrimRep
+
 primElemRepToPrimRep :: PrimElemRep -> PrimRep
 primElemRepToPrimRep Int8ElemRep   = Int8Rep
 primElemRepToPrimRep Int16ElemRep  = Int16Rep


=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -67,7 +67,7 @@ import GHC.Core.DataCon
 
 import GHC.Types.Literal
 import GHC.Types.SourceText
-import GHC.Types.RepType ( countFunRepArgs )
+import GHC.Types.RepType ( countFunRepArgs, typePrimRep )
 import GHC.Types.Name.Set
 import GHC.Types.Name
 import GHC.Types.Name.Env
@@ -1517,16 +1517,29 @@ shouldUnpackArgTy bang_opts prag fam_envs arg_ty
           | otherwise   -- Wrinkle (W4) of Note [Recursive unboxing]
           -> bang_opt_unbox_strict bang_opts
              || (bang_opt_unbox_small bang_opts
-                 && rep_tys `lengthAtMost` 1)  -- See Note [Unpack one-wide fields]
+                 && is_small_rep)  -- See Note [Unpack one-wide fields]
       where
         (rep_tys, _) = dataConArgUnpack arg_ty
 
+        -- Takes in the list of reps used to represent the dataCon after it's unpacked
+        -- and tells us if they can fit into 8 bytes. See Note [Unpack one-wide fields]
+        is_small_rep =
+          let -- Neccesary to look through unboxed tuples.
+              prim_reps = concatMap (typePrimRep . scaledThing . fst) $ rep_tys
+              -- Void types are erased when unpacked so we
+              nv_prim_reps = filter (not . isVoidRep) prim_reps
+              -- And then get the actual size of the unpacked constructor.
+              rep_size = sum $ map primRepSizeW64_B nv_prim_reps
+          in rep_size <= 8
+
     is_sum :: [DataCon] -> Bool
     -- We never unpack sum types automatically
     -- (Product types, we do. Empty types are weeded out by unpackable_type_datacons.)
     is_sum (_:_:_) = True
     is_sum _       = False
 
+
+
 -- Given a type already assumed to have been normalized by topNormaliseType,
 -- unpackable_type_datacons ty = Just datacons
 -- iff ty is of the form
@@ -1585,6 +1598,14 @@ However
 
 Here we can represent T with an Int#.
 
+Special care has to be taken to make sure we don't mistake fields with unboxed
+tuple/sum rep or very large reps. See #22309
+
+For consistency we unpack anything that fits into 8 bytes on a 64-bit platform,
+even when compiling for 32bit platforms. This way unpacking decisions will be the
+same for 32bit and 64bit systems. To do so we use primRepSizeW64_B instead of
+primRepSizeB. See also the tests in test case T22309.
+
 Note [Recursive unboxing]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider


=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -73,6 +73,16 @@ Compiler
 - Defaulting plugins can now propose solutions to entangled sets of type variables. This allows defaulting
   of multi-parameter type classes. See :ghc-ticket:`23832`.
 
+- The flag `-funbox-small-strict-fields` will now properly recognize unboxed tuples
+  containing multiple elements as large. Constructors like `Foo (# Int64, Int64# )`
+  will no longer be considered small and therefore not unboxed by default under `-O`
+  even when used as strict field. :ghc-ticket:`22309`.
+
+- The flag `-funbox-small-strict-fields` will now always unpack things as if compiling
+  for a 64bit platform. Even when generating code for a 32bit platform.
+  This makes core optimizations more consistent between 32bit and 64bit platforms
+  at the cost of slightly worse 32bit performance in edge cases.
+
 GHCi
 ~~~~
 


=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -1533,9 +1533,9 @@ as such you shouldn't need to set any of them explicitly. A flag
     default you can disable it for certain constructor fields using the
     ``NOUNPACK`` pragma (see :ref:`nounpack-pragma`).
 
-    Note that for consistency ``Double``, ``Word64``, and ``Int64``
-    constructor fields are unpacked on 32-bit platforms, even though
-    they are technically larger than a pointer on those platforms.
+    Note that for consistency constructor fields are unpacked on 32-bit platforms
+    as if it we were compiling for a 64-bit target even if fields are larger
+    than a pointer on those platforms.
 
 .. ghc-flag:: -funbox-strict-fields
     :shortdesc: Flatten strict constructor fields


=====================================
libraries/base/changelog.md
=====================================
@@ -2,6 +2,7 @@
 
 ## 4.20.0.0 *TBA*
   * Export `foldl'` from `Prelude` ([CLC proposal #167](https://github.com/haskell/core-libraries-committee/issues/167))
+  * Add `permutations` and `permutations1` to `Data.List.NonEmpty` ([CLC proposal #68](https://github.com/haskell/core-libraries-committee/issues/68))
   * Add a `RULE` to `Prelude.lookup`, allowing it to participate in list fusion ([CLC proposal #174](https://github.com/haskell/core-libraries-committee/issues/175))
   * The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))
   * Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
@@ -11,6 +12,7 @@
   * Export List from Data.List ([CLC proposal #182](https://github.com/haskell/core-libraries-committee/issues/182)).
   * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86))
   * Fix exponent overflow/underflow bugs in the `Read` instances for `Float` and `Double` ([CLC proposal #192](https://github.com/haskell/core-libraries-committee/issues/192))
+  * Implement `many` and `some` methods of `instance Alternative (Compose f g)` explicitly. ([CLC proposal #181](https://github.com/haskell/core-libraries-committee/issues/181))
 
   * The functions `GHC.Exts.dataToTag#` and `GHC.Base.getTag` have had
     their types changed to the following:


=====================================
libraries/base/src/Data/Functor/Compose.hs
=====================================
@@ -147,6 +147,10 @@ instance (Alternative f, Applicative g) => Alternative (Compose f g) where
     empty = Compose empty
     (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a))
       :: forall a . Compose f g a -> Compose f g a -> Compose f g a
+    some = coerce (fmap sequenceA . some :: f (g a) -> f (g [a]))
+      :: forall a . Compose f g a -> Compose f g [a]
+    many = coerce (fmap sequenceA . many :: f (g a) -> f (g [a]))
+      :: forall a . Compose f g a -> Compose f g [a]
 
 -- | The deduction (via generativity) that if @g x :~: g y@ then @x :~: y at .
 --


=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -78,6 +78,8 @@ module Data.List.NonEmpty (
    , groupBy1    -- :: (a -> a -> Bool) -> NonEmpty a -> NonEmpty (NonEmpty a)
    , groupWith1     -- :: (Foldable f, Eq b) => (a -> b) -> f a -> NonEmpty (NonEmpty a)
    , groupAllWith1  -- :: (Foldable f, Ord b) => (a -> b) -> f a -> NonEmpty (NonEmpty a)
+   , permutations
+   , permutations1
    -- * Sublist predicates
    , isPrefixOf  -- :: Foldable f => f a -> NonEmpty a -> Bool
    -- * \"Set\" operations
@@ -441,6 +443,30 @@ groupWith1 f = groupBy1 ((==) `on` f)
 groupAllWith1 :: (Ord b) => (a -> b) -> NonEmpty a -> NonEmpty (NonEmpty a)
 groupAllWith1 f = groupWith1 f . sortWith f
 
+-- | The 'permutations' function returns the list of all permutations of the argument.
+--
+-- @since 4.20.0.0
+permutations            :: [a] -> NonEmpty [a]
+permutations xs0        =  xs0 :| perms xs0 []
+  where
+    perms []     _  = []
+    perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
+      where interleave    xs     r = let (_,zs) = interleave' id xs r in zs
+            interleave' _ []     r = (ts, r)
+            interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
+                                     in  (y:us, f (t:y:us) : zs)
+-- The implementation of 'permutations' is adopted from 'Data.List.permutations',
+-- see there for discussion and explanations.
+
+-- | 'permutations1' operates like 'permutations', but uses the knowledge that its input is
+-- non-empty to produce output where every element is non-empty.
+--
+-- > permutations1 = fmap fromList . permutations . toList
+--
+-- @since 4.20.0.0
+permutations1 :: NonEmpty a -> NonEmpty (NonEmpty a)
+permutations1 xs = fromList <$> permutations (toList xs)
+
 -- | The 'isPrefixOf' function returns 'True' if the first argument is
 -- a prefix of the second.
 isPrefixOf :: Eq a => [a] -> NonEmpty a -> Bool


=====================================
libraries/base/src/Debug/Trace.hs
=====================================
@@ -143,13 +143,15 @@ traceId a = trace a a
 Like 'trace', but uses 'show' on the argument to convert it to a 'String'.
 
 This makes it convenient for printing the values of interesting variables or
-expressions inside a function. For example here we print the value of the
+expressions inside a function. For example, here we print the values of the
 variables @x@ and @y@:
 
->>> let f x y = traceShow (x,y) (x + y) in f (1+2) 5
-(3,5)
+>>> let f x y = traceShow ("x", x, "y", y) (x + y) in f (1+2) 5
+("x",3,"y",5)
 8
 
+Note in this example we also create simple labels just by including some strings.
+
 -}
 traceShow :: Show a => a -> b -> b
 traceShow = trace . show


=====================================
testsuite/driver/perf_notes.py
=====================================
@@ -123,11 +123,6 @@ AllowedPerfChange = NamedTuple('AllowedPerfChange',
                                 ('opts', Dict[str, str])
                                 ])
 
-MetricBaselineOracle = Callable[[WayName, GitHash], Baseline]
-MetricDeviationOracle = Callable[[WayName, GitHash], Optional[float]]
-MetricOracles = NamedTuple("MetricOracles", [("baseline", MetricBaselineOracle),
-                                             ("deviation", MetricDeviationOracle)])
-
 def parse_perf_stat(stat_str: str) -> PerfStat:
     field_vals = stat_str.strip('\t').split('\t')
     stat = PerfStat(*field_vals) # type: ignore


=====================================
testsuite/driver/testglobals.py
=====================================
@@ -4,7 +4,7 @@
 
 from my_typing import *
 from pathlib import Path
-from perf_notes import MetricChange, PerfStat, Baseline, MetricOracles, GitRef
+from perf_notes import MetricChange, PerfStat, Baseline, GitRef
 from datetime import datetime
 
 # -----------------------------------------------------------------------------
@@ -378,24 +378,20 @@ class TestOptions:
        # extra files to copy to the testdir
        self.extra_files = [] # type: List[str]
 
-       # Map from metric to (function from way and commit to baseline value, allowed percentage deviation) e.g.
-       #     { 'bytes allocated': (
-       #              lambda way commit:
-       #                    ...
-       #                    if way1: return None ...
-       #                    elif way2:return 9300000000 ...
-       #                    ...
-       #              , 10) }
-       # This means no baseline is available for way1. For way 2, allow a 10%
-       # deviation from 9300000000.
-       self.stats_range_fields = {} # type: Dict[MetricName, MetricOracles]
-
        # Is the test testing performance?
        self.is_stats_test = False
 
        # Does this test the compiler's performance as opposed to the generated code.
        self.is_compiler_stats_test = False
 
+       # Map from metric to information about that metric
+       #    { metric: { "deviation": <int>
+       #                The action to run to get the current value of the test
+       #              , "action": lambda way: <Int>
+       #                The action to run to get the baseline value of the test
+       #              , "oracle": lambda way commit: baseline value } }
+       self.generic_stats_test: Dict  = {} # Dict
+
        # should we run this test alone, i.e. not run it in parallel with
        # any other threads
        self.alone = False


=====================================
testsuite/driver/testlib.py
=====================================
@@ -28,7 +28,7 @@ from term_color import Color, colored
 import testutil
 from cpu_features import have_cpu_feature
 import perf_notes as Perf
-from perf_notes import MetricChange, PerfStat, MetricOracles
+from perf_notes import MetricChange, PerfStat
 extra_src_files = {'T4198': ['exitminus1.c']} # TODO: See #12223
 
 from my_typing import *
@@ -99,6 +99,10 @@ def isCompilerStatsTest() -> bool:
     opts = getTestOpts()
     return bool(opts.is_compiler_stats_test)
 
+def isGenericStatsTest() -> bool:
+    opts = getTestOpts()
+    return bool(opts.generic_stats_test)
+
 def isStatsTest() -> bool:
     opts = getTestOpts()
     return opts.is_stats_test
@@ -599,6 +603,44 @@ def extra_files(files):
 def _extra_files(name, opts, files):
     opts.extra_files.extend(files)
 
+# Record the size of a specific file
+def collect_size ( deviation, path ):
+    return collect_generic_stat ( 'size', deviation, lambda way: os.path.getsize(in_testdir(path)) )
+
+# Read a number from a specific file
+def stat_from_file ( metric, deviation, path ):
+    def read_file (way):
+        with open(in_testdir(path)) as f:
+            return int(f.read())
+    return collect_generic_stat ( metric, deviation, read_file )
+
+
+# Define a set of generic stat tests
+def collect_generic_stats ( get_stats ):
+    def f(name, opts, f=get_stats):
+        return _collect_generic_stat(name, opts, get_stats)
+    return f
+
+# Define the 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, 'action': get_stat } } )
+
+def _collect_generic_stat(name : TestName, opts, get_stat):
+
+
+    # Add new stats to the stat list
+    opts.generic_stats_test.update(get_stat)
+
+    # Add the "oracle" which determines the stat baseline
+    for (metric, info) in get_stat.items():
+        def baselineByWay(way, target_commit, metric=metric):
+            return Perf.baseline_metric( \
+                              target_commit, name, config.test_env, metric, way, \
+                              config.baseline_commit )
+        opts.generic_stats_test[metric]["oracle"] = baselineByWay
+
+
 # -----
 
 # Defaults to "test everything, and only break on extreme cases"
@@ -625,6 +667,9 @@ def collect_compiler_stats(metric='all',deviation=20):
 def collect_stats(metric='all', deviation=20):
     return lambda name, opts, m=metric, d=deviation: _collect_stats(name, opts, m, d)
 
+def statsFile(comp_test: bool, name: str) -> str:
+    return name + ('.comp' if comp_test else '') + '.stats'
+
 # This is an internal function that is used only in the implementation.
 # 'is_compiler_stats_test' is somewhat of an unfortunate name.
 # If the boolean is set to true, it indicates that this test is one that
@@ -664,15 +709,35 @@ def _collect_stats(name: TestName, opts, metrics, deviation, is_compiler_stats_t
         # The nonmoving collector does not support -G1
         _omit_ways(name, opts, [WayName(name) for name in ['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc']])
 
+    # How to read the result of the performance test
+    def read_stats_file(way, metric_name):
+        # Confusingly compile time ghci tests are actually runtime tests, so we have
+        # to go and look for the name.stats file rather than name.comp.stats file.
+        compiler_stats_test = is_compiler_stats_test and not (way == "ghci" or way == "ghci-opt")
+        stats_file = Path(in_testdir(statsFile(compiler_stats_test, name)))
+        try:
+            stats_file_contents = stats_file.read_text()
+        except IOError as e:
+            raise Exception(failBecause(str(e)))
+        field_match = re.search('\\("' + metric_name + '", "([0-9]+)"\\)', stats_file_contents)
+        if field_match is None:
+            print('Failed to find metric: ', metric_name)
+            raise Exception(failBecause("No such metric"))
+        else:
+            val = field_match.group(1)
+            assert val is not None
+            return int(val)
+
+
+    collect_stat = {}
     for metric_name in metrics:
+        def action_generator(mn):
+            return lambda way: read_stats_file(way, mn)
         metric = '{}/{}'.format(tag, metric_name)
-        def baselineByWay(way, target_commit, metric=metric):
-            return Perf.baseline_metric( \
-                              target_commit, name, config.test_env, metric, way, \
-                              config.baseline_commit )
+        collect_stat[metric] = { "deviation": deviation
+                                , "action": action_generator(metric_name) }
 
-        opts.stats_range_fields[metric] = MetricOracles(baseline=baselineByWay,
-                                                        deviation=deviation)
+    _collect_generic_stat(name, opts, collect_stat)
 
 # -----
 
@@ -1581,6 +1646,11 @@ async def do_compile(name: TestName,
         diff_file_name.unlink()
         return failBecause('stderr mismatch', stderr=stderr)
 
+    opts = getTestOpts()
+    if isGenericStatsTest():
+        statsResult = check_generic_stats(TestName(name), way, opts.generic_stats_test)
+        if badResult(statsResult):
+            return statsResult
 
     # no problems found, this test passed
     return passed()
@@ -1717,13 +1787,9 @@ async def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts )
 async def warn_and_run( name, way, extra_hc_opts ):
     return await compile_and_run__( name, way, None, [], extra_hc_opts, compile_stderr = True)
 
-def stats( name, way, stats_file ):
-    opts = getTestOpts()
-    return check_stats(name, way, in_testdir(stats_file), opts.stats_range_fields)
-
 async def static_stats( name, way, stats_file ):
     opts = getTestOpts()
-    return check_stats(name, way, in_statsdir(stats_file), opts.stats_range_fields)
+    return check_generic_stats(name, way, opts.generic_stats_test)
 
 def metric_dict(name, way, metric, value) -> PerfStat:
     return Perf.PerfStat(
@@ -1733,75 +1799,58 @@ def metric_dict(name, way, metric, value) -> PerfStat:
         metric   = metric,
         value    = value)
 
-# -----------------------------------------------------------------------------
-# Check test stats. This prints the results for the user.
-# name: name of the test.
-# way: the way.
-# stats_file: the path of the stats_file containing the stats for the test.
-# range_fields: see TestOptions.stats_range_fields
-# Returns a pass/fail object. Passes if the stats are within the expected value ranges.
-# This prints the results for the user.
-def check_stats(name: TestName,
-                way: WayName,
-                stats_file: Path,
-                range_fields: Dict[MetricName, MetricOracles]
-                ) -> PassFail:
+
+
+def check_generic_stats(name, way, get_stats):
+    for (metric, gen_stat) in get_stats.items():
+        res = report_stats(name, way, metric, gen_stat)
+        if badResult(res):
+            return res
+    return passed()
+
+def report_stats(name, way, metric, gen_stat):
+    try:
+        actual_val = gen_stat['action'](way)
+    # Metrics can exit early by throwing an Exception with the desired result.
+    # This is used for both failure, and skipping computing the metric.
+    except Exception as e:
+        result = e.args[0]
+        return result
+
     head_commit = Perf.commit_hash(GitRef('HEAD')) if Perf.inside_git_repo() else None
     if head_commit is None:
         return passed()
 
     result = passed()
-    if range_fields:
-        try:
-            stats_file_contents = stats_file.read_text()
-        except IOError as e:
-            return failBecause(str(e))
-
-        for (metric, baseline_and_dev) in range_fields.items():
-            # Remove any metric prefix e.g. "runtime/" and "compile_time/"
-            stat_file_metric = metric.split("/")[-1]
-            perf_change = None
-
-            field_match = re.search('\\("' + stat_file_metric + '", "([0-9]+)"\\)', stats_file_contents)
-            if field_match is None:
-                print('Failed to find metric: ', stat_file_metric)
-                result = failBecause('no such stats metric')
-            else:
-                val = field_match.group(1)
-                assert val is not None
-                actual_val = int(val)
-
-                # Store the metric so it can later be stored in a git note.
-                perf_stat = metric_dict(name, way, metric, actual_val)
-
-                # If this is the first time running the benchmark, then pass.
-                baseline = baseline_and_dev.baseline(way, head_commit) \
-                    if Perf.inside_git_repo() else None
-                if baseline is None:
-                    metric_result = passed()
-                    perf_change = MetricChange.NewMetric
-                else:
-                    tolerance_dev = baseline_and_dev.deviation
-                    (perf_change, metric_result) = Perf.check_stats_change(
-                        perf_stat,
-                        baseline,
-                        tolerance_dev,
-                        config.allowed_perf_changes,
-                        config.verbose >= 4)
-
-                t.metrics.append(PerfMetric(change=perf_change, stat=perf_stat, baseline=baseline))
-
-                # If any metric fails then the test fails.
-                # Note, the remaining metrics are still run so that
-                # a complete list of changes can be presented to the user.
-                if not metric_result.passed:
-                    if config.ignore_perf_increases and perf_change == MetricChange.Increase:
-                        metric_result = passed()
-                    elif config.ignore_perf_decreases and perf_change == MetricChange.Decrease:
-                        metric_result = passed()
-
-                    result = metric_result
-
+    # Store the metric so it can later be stored in a git note.
+    perf_stat = metric_dict(name, way, metric, actual_val)
+
+    # If this is the first time running the benchmark, then pass.
+    baseline = gen_stat['oracle'](way, head_commit) \
+        if Perf.inside_git_repo() else None
+    if baseline is None:
+        metric_result = passed()
+        perf_change = MetricChange.NewMetric
+    else:
+        (perf_change, metric_result) = Perf.check_stats_change(
+            perf_stat,
+            baseline,
+            gen_stat["deviation"],
+            config.allowed_perf_changes,
+            config.verbose >= 4)
+
+    t.metrics.append(PerfMetric(change=perf_change, stat=perf_stat, baseline=baseline))
+
+    # If any metric fails then the test fails.
+    # Note, the remaining metrics are still run so that
+    # a complete list of changes can be presented to the user.
+    if not metric_result.passed:
+        if config.ignore_perf_increases and perf_change == MetricChange.Increase:
+            metric_result = passed()
+        elif config.ignore_perf_decreases and perf_change == MetricChange.Decrease:
+            metric_result = passed()
+
+        result = metric_result
     return result
 
 # -----------------------------------------------------------------------------
@@ -1863,8 +1912,8 @@ async def simple_build(name: Union[TestName, str],
     else:
         to_do = '-c' # just compile
 
-    stats_file = name + '.comp.stats'
     if isCompilerStatsTest():
+        stats_file = statsFile(True, name)
         # Set a bigger chunk size to reduce variation due to additional under/overflowing
         # The tests are attempting to test how much work the compiler is doing by proxy of
         # bytes allocated. The additional allocations caused by stack overflow can cause
@@ -1913,10 +1962,6 @@ async def simple_build(name: Union[TestName, str],
             stderr_contents = actual_stderr_path.read_text(encoding='UTF-8', errors='replace')
             return failBecause('exit code non-0', stderr=stderr_contents)
 
-    if isCompilerStatsTest():
-        statsResult = check_stats(TestName(name), way, in_testdir(stats_file), opts.stats_range_fields)
-        if badResult(statsResult):
-            return statsResult
 
     return passed()
 
@@ -1953,7 +1998,7 @@ async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: st
     #   assume we are running a program via ghci. Collect stats
     stats_file = None # type: Optional[str]
     if isStatsTest() and (not isCompilerStatsTest() or way == 'ghci' or way == 'ghci-opt'):
-        stats_file = name + '.stats'
+        stats_file = statsFile(False, name)
         stats_args = ' +RTS -V0 -t' + stats_file + ' --machine-readable -RTS'
     else:
         stats_args = ''
@@ -1999,11 +2044,13 @@ async def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: st
     if check_prof and not await check_prof_ok(name, way):
         return failBecause('bad profile')
 
-    # Check runtime stats if desired.
-    if stats_file is not None:
-        return check_stats(name, way, in_testdir(stats_file), opts.stats_range_fields)
-    else:
-        return passed()
+    # Check the results of stats tests
+    if isGenericStatsTest():
+        statsResult = check_generic_stats(TestName(name), way, opts.generic_stats_test)
+        if badResult(statsResult):
+            return statsResult
+
+    return passed()
 
 def rts_flags(way: WayName) -> str:
     args = config.way_rts_flags.get(way, [])


=====================================
testsuite/tests/count-deps/Makefile
=====================================
@@ -16,8 +16,10 @@ LIBDIR := "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
 
 .PHONY: count-deps-parser
 count-deps-parser:
-	$(COUNT_DEPS) $(LIBDIR) "GHC.Parser"
+	$(COUNT_DEPS) $(LIBDIR) "GHC.Parser" | tee out
+	cat out | tail -n +2 | wc -l > SIZE
 
 .PHONY: count-deps-ast
 count-deps-ast:
-	$(COUNT_DEPS) $(LIBDIR) "Language.Haskell.Syntax"
+	$(COUNT_DEPS) $(LIBDIR) "Language.Haskell.Syntax" | tee out
+	cat out | tail -n +2 | wc -l > SIZE


=====================================
testsuite/tests/count-deps/all.T
=====================================
@@ -1,2 +1,2 @@
-test('CountDepsAst', [req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-ast'])
-test('CountDepsParser', [req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-parser'])
+test('CountDepsAst', [stat_from_file('deps', 100, 'SIZE'), req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-ast'])
+test('CountDepsParser', [stat_from_file('deps', 100, 'SIZE'), req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-parser'])


=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1410,6 +1410,8 @@ module Data.List.NonEmpty where
   nub :: forall a. GHC.Classes.Eq a => NonEmpty a -> NonEmpty a
   nubBy :: forall a. (a -> a -> GHC.Types.Bool) -> NonEmpty a -> NonEmpty a
   partition :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+  permutations :: forall a. [a] -> NonEmpty [a]
+  permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a)
   prependList :: forall a. [a] -> NonEmpty a -> NonEmpty a
   repeat :: forall a. a -> NonEmpty a
   reverse :: forall a. NonEmpty a -> NonEmpty a


=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1410,6 +1410,8 @@ module Data.List.NonEmpty where
   nub :: forall a. GHC.Classes.Eq a => NonEmpty a -> NonEmpty a
   nubBy :: forall a. (a -> a -> GHC.Types.Bool) -> NonEmpty a -> NonEmpty a
   partition :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+  permutations :: forall a. [a] -> NonEmpty [a]
+  permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a)
   prependList :: forall a. [a] -> NonEmpty a -> NonEmpty a
   repeat :: forall a. a -> NonEmpty a
   reverse :: forall a. NonEmpty a -> NonEmpty a


=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1410,6 +1410,8 @@ module Data.List.NonEmpty where
   nub :: forall a. GHC.Classes.Eq a => NonEmpty a -> NonEmpty a
   nubBy :: forall a. (a -> a -> GHC.Types.Bool) -> NonEmpty a -> NonEmpty a
   partition :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+  permutations :: forall a. [a] -> NonEmpty [a]
+  permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a)
   prependList :: forall a. [a] -> NonEmpty a -> NonEmpty a
   repeat :: forall a. a -> NonEmpty a
   reverse :: forall a. NonEmpty a -> NonEmpty a


=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -1410,6 +1410,8 @@ module Data.List.NonEmpty where
   nub :: forall a. GHC.Classes.Eq a => NonEmpty a -> NonEmpty a
   nubBy :: forall a. (a -> a -> GHC.Types.Bool) -> NonEmpty a -> NonEmpty a
   partition :: forall a. (a -> GHC.Types.Bool) -> NonEmpty a -> ([a], [a])
+  permutations :: forall a. [a] -> NonEmpty [a]
+  permutations1 :: forall a. NonEmpty a -> NonEmpty (NonEmpty a)
   prependList :: forall a. [a] -> NonEmpty a -> NonEmpty a
   repeat :: forall a. a -> NonEmpty a
   reverse :: forall a. NonEmpty a -> NonEmpty a


=====================================
testsuite/tests/perf/size/Makefile
=====================================
@@ -0,0 +1,7 @@
+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
=====================================
@@ -0,0 +1,3 @@
+test('size_hello', [collect_size(3, 'size_hello.o')], compile, [''])
+
+test('libdir',[stat_from_file('size', 3, 'SIZE')], makefile_test, ['libdir_size'] )


=====================================
testsuite/tests/perf/size/size_hello.hs
=====================================
@@ -0,0 +1,3 @@
+module Main where
+
+main = print "Hello World!"


=====================================
testsuite/tests/simplCore/should_compile/T22309.hs
=====================================
@@ -0,0 +1,35 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module ShouldCompile where
+
+import GHC.Int
+import GHC.Exts
+
+-- These should unbox into another constructor
+data UA = Mk_A !Int
+data UB = Mk_B !Int64
+data UC = Mk_C !Int32
+data UD = Mk_D !Int32 !Int32
+data UE = Mk_E !(# Int# #)
+data UF = Mk_F !(# Double #)
+
+-- These should not be unpacked into another constructor.
+data NU_A = NU_MkA (# Int64, Int64 #)
+data NU_B = NU_MkB !Int64 !Int64
+
+-- The types we unbox into
+
+-- These should unpack their fields.
+data WU_A = MkW_A !UA
+data WU_B = MkW_B !UB
+data WU_C = MkW_C !UC
+data WU_D = MkW_D !UD
+data WU_E = MkW_E !UE
+data WU_F = MkW_F !UF
+
+-- These should not unpack their fields, as they are multiple words large.
+data WNU_A = MkW_NA !NU_A
+data WNU_B = MkW_NB !NU_B
+
+


=====================================
testsuite/tests/simplCore/should_compile/T22309.stderr
=====================================
@@ -0,0 +1,88 @@
+
+==================== Final STG: ====================
+$WMkW_NB :: NU_B %1 -> WNU_B =
+    \r [conrep]
+        case conrep of conrep1 { __DEFAULT -> MkW_NB [conrep1]; };
+
+$WMkW_NA :: NU_A %1 -> WNU_A =
+    \r [conrep]
+        case conrep of conrep1 { __DEFAULT -> MkW_NA [conrep1]; };
+
+$WMkW_F :: UF %1 -> WU_F =
+    \r [conrep] case conrep of { Mk_F us -> MkW_F [us]; };
+
+$WMkW_E :: UE %1 -> WU_E =
+    \r [conrep] case conrep of { Mk_E us -> MkW_E [us]; };
+
+$WMkW_D :: UD %1 -> WU_D =
+    \r [conrep]
+        case conrep of { Mk_D unbx unbx1 -> MkW_D [unbx unbx1]; };
+
+$WMkW_C :: UC %1 -> WU_C =
+    \r [conrep] case conrep of { Mk_C unbx -> MkW_C [unbx]; };
+
+$WMkW_B :: UB %1 -> WU_B =
+    \r [conrep] case conrep of { Mk_B unbx -> MkW_B [unbx]; };
+
+$WMkW_A :: UA %1 -> WU_A =
+    \r [conrep] case conrep of { Mk_A unbx -> MkW_A [unbx]; };
+
+$WNU_MkB :: Int64 %1 -> Int64 %1 -> NU_B =
+    \r [conrep conrep1]
+        case conrep of {
+        I64# unbx ->
+        case conrep1 of { I64# unbx1 -> NU_MkB [unbx unbx1]; };
+        };
+
+$WMk_D :: Int32 %1 -> Int32 %1 -> UD =
+    \r [conrep conrep1]
+        case conrep of {
+        I32# unbx -> case conrep1 of { I32# unbx1 -> Mk_D [unbx unbx1]; };
+        };
+
+$WMk_C :: Int32 %1 -> UC =
+    \r [conrep] case conrep of { I32# unbx -> Mk_C [unbx]; };
+
+$WMk_B :: Int64 %1 -> UB =
+    \r [conrep] case conrep of { I64# unbx -> Mk_B [unbx]; };
+
+$WMk_A :: Int %1 -> UA =
+    \r [conrep] case conrep of { I# unbx -> Mk_A [unbx]; };
+
+MkW_NB :: NU_B %1 -> WNU_B =
+    \r [eta] case eta of eta { __DEFAULT -> MkW_NB [eta]; };
+
+MkW_NA :: NU_A %1 -> WNU_A =
+    \r [eta] case eta of eta { __DEFAULT -> MkW_NA [eta]; };
+
+MkW_F :: (# Double #) %1 -> WU_F = \r [us] MkW_F [us];
+
+MkW_E :: (# Int# #) %1 -> WU_E = \r [us] MkW_E [us];
+
+MkW_D :: Int32# %1 -> Int32# %1 -> WU_D =
+    \r [eta eta] MkW_D [eta eta];
+
+MkW_C :: Int32# %1 -> WU_C = \r [eta] MkW_C [eta];
+
+MkW_B :: Int64# %1 -> WU_B = \r [eta] MkW_B [eta];
+
+MkW_A :: Int# %1 -> WU_A = \r [eta] MkW_A [eta];
+
+NU_MkB :: Int64# %1 -> Int64# %1 -> NU_B =
+    \r [eta eta] NU_MkB [eta eta];
+
+NU_MkA :: (# Int, Int #) %1 -> NU_A = \r [us us] NU_MkA [us us];
+
+Mk_F :: (# Double #) %1 -> UF = \r [us] Mk_F [us];
+
+Mk_E :: (# Int# #) %1 -> UE = \r [us] Mk_E [us];
+
+Mk_D :: Int32# %1 -> Int32# %1 -> UD = \r [eta eta] Mk_D [eta eta];
+
+Mk_C :: Int32# %1 -> UC = \r [eta] Mk_C [eta];
+
+Mk_B :: Int64# %1 -> UB = \r [eta] Mk_B [eta];
+
+Mk_A :: Int# %1 -> UA = \r [eta] Mk_A [eta];
+
+


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -488,6 +488,7 @@ test('T23307', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress
 test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques'])
 test('T23307b', normal, compile, ['-O'])
 test('T23307c', normal, compile, ['-O'])
+test('T22309', [grep_errmsg(r'MkW'), only_ways(['optasm']) ], compile, ['-O -ddump-stg-final -dsuppress-uniques -dsuppress-all -dno-typeable-binds -dno-suppress-type-signatures -dsuppress-module-prefixes'])
 test('T23426', normal, compile, ['-O'])
 test('T23491a', [extra_files(['T23491.hs']), grep_errmsg(r'Float out')], multimod_compile, ['T23491', '-ffull-laziness -ddump-full-laziness'])
 test('T23491b', [extra_files(['T23491.hs']), grep_errmsg(r'Float inwards')], multimod_compile, ['T23491', '-ffloat-in -ddump-float-in'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f51e88d1641ea9f9e276e15c70ffcbfdc4beef84...94021d18fbaef1b3ae984fe6d8c4bcb9de63adcf

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f51e88d1641ea9f9e276e15c70ffcbfdc4beef84...94021d18fbaef1b3ae984fe6d8c4bcb9de63adcf
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/20231117/4864f77b/attachment-0001.html>


More information about the ghc-commits mailing list